$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
;
