REBOL [ Title: "REBOL Directory Services Lookup" Date: 1-Jun-2001 Version: 1.1.0 File: %lookup.r Author: "Carl Sassenrath" Purpose: {Provides a simple but effective directory server for peer-to-peer and other types of REBOL applications. Can be installed on any CGI webserver. } History: [ 1.1.0 "Thanks to Cal Dixon for file lock." ] Email: %carl--rebol--com Examples: { "cmd=post&service=chat&name=carl&data=9080" "cmd=post&service=chat "cmd=find&service=chat&name=carl" "cmd=remove&service=chat&name=sean" "cmd=find&service=chat&name=carl" "cmd=find&service=chat" "cmd=find" "cmd=version" "cmd=info" } Note: { Structure: "service-name" ["name" ip time data] } library: [ level: 'intermediate platform: none type: 'tool domain: [cgi ldc other-net tcp] tested-under: none support: none license: none see-also: none ] ] print "Content-type: text/html^/^/" entry-size: 4 ; size of each service entry time-out: 0:05 ; remove service item after this amount of time test: not system/options/cgi/remote-addr ; enables local test mode op-email: %op--example--com set-net [%site--example--net example.net] either test [ cgi: context [ remote-addr: "1.2.3.4" query-string: "cmd=post&service=chat&name=sean&data=9080" ] file-path: %./ ][ cgi: system/options/cgi file-path: %/home/WWW_pages/rebol/ ] serv-file: file-path/service-db.r lock-path: file-path/lock- request: context [ cmd: service: options: name: data: none ip: to-tuple cgi/remote-addr ] lock-file: func [file retries /local retry] [ file: second split-path file retry: 0 while [error? try [make-dir rejoin [lock-path file "/"]]] [ if (retry: retry + 1) > retries [return false] wait 0.5 ] true ] unlock-file: func [file] [ delete rejoin [lock-path second split-path file "/"] ] save-services: func [data] [ either lock-file serv-file 40 [ save serv-file data unlock-file serv-file ][ send op-email {Lookup Error^/File lock failed, check server.^/} ] ] post-service: func [serv req /local item entry] [ if not all [req/service req/name req/data] [return 'bad-post] if none? serv [ serv: copy [] repend services [req/service serv] ] clear-old serv item: find serv req/name entry: reduce [req/name req/ip now req/data] either item [change/part item entry entry-size][insert serv entry] save-services services serv ] clear-old: func [serv /local flag] [ while [not tail? serv] [ either now - time-out > serv/3 [remove/part serv entry-size][ flag: true serv: skip serv entry-size ] ] if flag [save-services services] head serv ] find-service: func [serv req /local item entry] [ all [ result: services serv result: serv clear-old serv req/name result: 'none item: find serv req/name copy/part item entry-size ] result ] remove-service: func [serv req /local item] [ either all [serv req/name item: find serv req/name] [ either item/2 = req/ip [ remove/part item entry-size save-services services 'ok ]['bad-ip] ]['bad-target] ] req: make request decode-cgi cgi/query-string services: either exists? serv-file [load serv-file][[]] serv: select services req/service probe switch/default req/cmd [ "post" [post-service serv req] "find" [find-service serv req] "remove" [remove-service serv req] "version" [system/script/header/version] "info" [third system/script/header] ]['bad-command] if test [print "done" halt]