$include $lib/alynna
$pubdef :
$def DEBUG? prog "?" flag? if
$pubdef BaseURL { "http://" "servername" sysparm ":" "wwwport" sysparm }cat
$pubdef DispatchURL { "http://" "servername" sysparm ":" "wwwport" sysparm "/ajax" }cat
$def SESSIONINFO #0 "@ajaxSessions"
$pubdef }w }cat descr swap notify_descriptor
$pubdef XHTML { "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" }w

lvar web
lvar cgi
lvar cookies
lvar post
lvar session
lvar headers
$pubdef DEFINE_AJAX_VARS lvar web lvar cgi lvar cookies lvar post lvar session lvar headers

$def preload descr httpdata web ! descr get_cgi cgi ! descr get_cookies cookies ! { web @ "postdata" [] dup not if pop else foreach var! tmp tmp @ array_count 1 = if tmp @ 0 [] else tmp @ then repeat then }dict post ! web @ "HeaderData" [] headers !
$pubdef preload descr httpdata web ! descr get_cgi cgi ! descr get_cookies cookies ! { web @ "postdata" [] dup not if pop else foreach var! tmp tmp @ array_count 1 = if tmp @ 0 [] else tmp @ then repeat then }dict post ! web @ "HeaderData" [] headers !

$def associate_session descr get_cookies dup cookies ! "session" [] dup not if pop #-1 else dup session ! "owner" getsession dup ok? not if pop #-1 then then me !
$pubdef associate_session descr get_cookies dup cookies ! "session" [] dup not if pop #-1 else dup session ! "owner" getsession dup ok? not if pop #-1 then then me !

$libdef guid
: zeropad[ str:hex int:digits -- str:result ]
"0000000000000000" hex @ strcat dup strlen digits @ - strcut swap pop
;
: guid[ -- str:guid ]
{
 systime_precise modf swap int itoh
 "-"
 rot 65536.0 * int itoh 4 zeropad
 "-"
 random 65536 % itoh 4 zeropad
 "-"
 random 65536.0 / int itoh 4 zeropad
 "-"
 frand 2.0 16.0 pow * int itoh 4 zeropad
 frand 2.0 16.0 pow * int itoh 4 zeropad
 frand 2.0 16.0 pow * int itoh 4 zeropad
}join
; PUBLIC guid


: validateuid[ uid -- out ]
uid @ dbref? if
 uid @ "~ajax/session" getprop dup not if pop "00000000-0000-0000-0000-000000000000" exit then
then
uid @ string? not if
 "00000000-0000-0000-0000-000000000000" exit
then
uid @
;

: getsession[ uid s:p -- x:value ] SESSIONINFO { swap "/" uid @ validateuid "/" p @ }cat getprop ; PUBLIC getsession $libdef getsession
: setsession[ uid s:p x:value -- ] SESSIONINFO { swap "/" uid @ validateuid "/" p @ }cat value @ setprop ; PUBLIC setsession $libdef setsession
: delsession[ uid s:p ] SESSIONINFO { swap "/" uid @ validateuid "/" p @ }cat remove_prop ; PUBLIC delsession $libdef delsession
: newsession[ i:de d:target s:password -- s:uid ]
target @ password @ checkpassword if
 guid var! uid
 target @ "~ajax/session" uid @ setprop
 uid @ "owner" target @ setsession
 uid @ "ip" de @ descripnum setsession
 uid @ "atime" systime setsession
 uid @
else
 ""
then
; PUBLIC newsession $libdef newsession
: endsession[ uid -- ]
var target
 uid @ dbref? if
  uid @ target !
  target @ "~ajax/session" getprop uid !
 else
  uid @ "owner" getsession target !
 then
 SESSIONINFO { swap "/" uid @ "/" }cat remove_prop
 target @ "~ajax/session" remove_prop
; PUBLIC endsession $libdef endsession

: cgi_encode[ s:in -- s:out ]
  {
   0 var! x begin
   x ++
   x @ in @ strlen > if break then
   in @ x @ 1 midstr var! c
   "$&+,/:;=?@ <>#%{}|^~[]`\\\" " c @ (") instr
   c @ ctoi 32 <
   c @ ctoi 127 >
   or or if
    c @ ctoi itoh "00" swap strcat dup strlen 2 - strcut swap pop "%" swap strcat
   else
    c @
   then
   repeat
  }cat
; PUBLIC cgi_encode $libdef cgi_encode

: cgi_decode[ s:in -- s:out ]
  {
   0 var! x begin
   x ++
   x @ in @ strlen > if break then
   in @ x @ 1 midstr dup "%" strcmp not if
    pop x ++
    in @ x @ 2 midstr htoi itoc
    x ++
   then
   repeat
  }cat
; PUBLIC cgi_decode $libdef cgi_decode

: get_headers[ i:d -- dict:headers ]
d @ httpdata "HeaderData" []
; PUBLIC get_headers $libdef get_headers

: get_cgi[ i:d -- dict:cgi ]
{
 d @ httpdata "CGIParams" [] " " "+" subst "&" explode_array dup if foreach var! txt pop txt @ "=" split cgi_decode swap cgi_decode swap repeat else pop then
}dict
; PUBLIC get_cgi $libdef get_cgi

: cookies-d2s[ dict:cookies -- string ]
{
 cookies @ foreach "=" swap strcat strcat repeat
}array "; " array_join
; PUBLIC cookies-d2s $libdef cookies-d2s

: cookies-s2d[ string:cookies -- dict ]
{
  cookies @ "; " explode_array foreach swap pop "=" split repeat
} 2 / array_make_dict
; PUBLIC cookies-s2d $libdef cookies-s2d

: get_cookies[ i:de -- dict:cookies ]
de @ get_headers "Cookie" [] dup string? if cookies-s2d else pop { }dict then
; PUBLIC get_cookies $libdef get_cookies

: set_cookie[ s:sess ]
 { "Set-Cookie: session=" sess @ "; expires=" "%a, %d %b %Y %H:%M:%S GMT\r\n" systime 86400 7 * + timefmt }cat
; PUBLIC set_cookie $libdef set_cookie

: clear_cookie
 { "Set-Cookie: session=; expires=" "%a, %d %b %Y %H:%M:%S GMT\r\n" 1 timefmt  }cat
; PUBLIC clear_cookie $libdef clear_cookie

: send_headers[ s:cookie ]
associate_session
descr {
      "HTTP/1.1 200 OK\r\n"
      "Server: " version "MUCK/" "MUCK" subst "\r\n"
      "Connection: close\r\n"
      "Content-Type: text/html, charset=ISO-8859-1\r\n"
      "Cache-Control: post-check=0, pre-check=0\r\n"
      "Pragma: no-cache\r\n"
      "Expires: %a, %d %b %Y %H:%M:%S GMT\r\n" 1234567890 timefmt
      "Cache-Control: no-cache, no-store, must-revalidate\r\n"
      "Last-Modified: %a, %d %b %Y %H:%M:%S GMT\r\n" systime timefmt
      cookie @ not if ( expire a cookie if we have no session data for it )
       cookies @ "session" [] dup if "owner" getsession not if clear_cookie then else pop then
      then
      cookie @ dup not if pop then
   }cat notify_descriptor
   descr 13 notify_descriptor_char
   descr 10 notify_descriptor_char
; PUBLIC send_headers $libdef send_headers

: keyed_decrypt[ s:input i:de d:target -- s:salt ]
input @ base64decode
{ #0 "@ajax/pubkey" getprop "|" de @ descripnum "|#" target @ int }cat base64encode
strdecrypt
; PUBLIC keyed_decrypt $libdef keyed_decrypt

: keyed_encrypt[ s:input i:de d:target -- s:output ]
input @
{ #0 "@ajax/pubkey" getprop "|" de @ descripnum "|#" target @ int }cat base64encode
strencrypt base64encode
; PUBLIC keyed_encrypt $libdef keyed_encrypt

: sysMessage
{
 #0 "@ajax/sysmessage" getprop dup if "<br />" else pop then
 me @ if
  me @ "~ajax/sysmessage" getprop dup if "<br />" else pop then
  me @ "~ajax/message" getprop dup if "<br />" me @ "~ajax/message" remove_prop else pop then
 then
}cat
; PUBLIC sysMessage $libdef sysMessage

: sysMessage_Request[ a:lines -- s:uid ]
guid var! uid
#0 { "@ajaxtmp/" uid @ }cat lines @ array_put_proplist
uid @
; PUBLIC sysMessage_Request $libdef sysMessage_request

: sysMessage_Return[ s:back s:uid -- ]
#0 { "@ajaxtmp/" uid @ "/back" }cat back @ setprop
; PUBLIC sysMessage_Return $libdef sysMessage_Return

: sysMessage_Response[ -- s:output ]
preload
cgi @ "uid" [] var! uid
{
 #0 { "@ajaxtmp/" uid @ }cat array_get_proplist "" array_join
 #0 { "@ajaxtmp/" uid @ "/back" }cat getprop if
  #0 if "<p><a href='" #0 { "@ajaxtmp/" uid @ "/back" }cat getprop "'>Click here to return</a></p>" then
 then
}cat
#0 { "@ajaxtmp/" uid @ "#" }cat remove_prop
#0 { "@ajaxtmp/" uid @ }cat remove_prop
; PUBLIC sysMessage_Response $libdef sysMessage_Response


: main
pop
( descr httpdata debug_line pop )
preload
associate_session
( post @ debug_line pop )
"" send_headers
session @ if ( If I have a session, keep it current )
 session @ "atime" systime setsession
then

( For the AJAX queues, because the site checks on modules )
( Your module will be called with the current user or #-1 if noone is logged into this session )
( The function 'updated?' will be called.   If you return a 1 it will be sent back to the browser for refresh. )
( Answer 1 if :
  * You always need updated
  * You don't always need updated but something changed and you do now
  Answer for the user sent to the module.
  If you don't need to be updated, answer 0.
)
{
post @ "r" [] atoi if  ( R=1 for first time refresh, so return the name of every module )
 #0 "/@ajax/queue/" array_get_propvals foreach var! module var! modname
  modname @
 repeat
else ( when R=0 query each module if it needs refreshed.. )
 #0 "/@ajax/queue/" array_get_propvals foreach var! module var! modname
  me @ module @ "updated?" call if modname @ then
 repeat
then
}array ";" array_join descr swap notify_descriptor
;

PHP Warning

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead:"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead"

Warning: "preg_replace(): The /e modifier is deprecated, use preg_replace_callback instead:"