FindPage
View Source:
CyberLeo/Scraps/alynna_lib_ajax
<code brush="plain"> $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 ; </code>
