REBOL [ Title: "Lookup service client" Purpose: { Client for the temporary lookup service. } Author: "Gabriele Santilli" EMail: giesse@rebol.it File: %lookup.r License: { Copyright (C) 2005 Gabriele Santilli This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. http://www.gnu.org/copyleft/gpl.html } Date: 16-Feb-2005 Version: 1.9.0 ; majorv.minorv.status ; status: 0: unfinished; 1: testing; 2: stable History: [ 4-Feb-2005 1.1.0 "History start" 4-Feb-2005 1.2.0 "renew-lookup-session" 4-Feb-2005 1.3.0 "destroy-lookup-session" 8-Feb-2005 1.4.0 "lookup-name" 8-Feb-2005 1.5.0 "set-target and get-target" 8-Feb-2005 1.6.0 "Added a few APPEND-LOGs" 8-Feb-2005 1.7.0 "Fixed a bug in the server-level catch function" 16-Feb-2005 1.8.0 "ondemand-iperf-server/port-number is now used as the stored value" 16-Feb-2005 1.9.0 "Added user-data field to targets" ] ] context [ to-ahttp: func [url] [ url: replace copy url http:// ahttp:// replace url https:// ahttps:// ] lookup-service: closure [ message callback /local port result ] [ append-log 10 ["Lookup service message: " trim/lines mold message] port: open/custom to-ahttp get-config/accept/default 'lookup-service-url url! http://iperf1.showcase.surfnet.nl/cgi-bin/lookup.cgi reduce ['post mold/all/only :message] port/awake: func [port event [word! error!]] [ if error? :event [ attempt [close port] port/awake: none do-after 0 [callback none] return false ] if event = 'close [ result: attempt [to block! copy port] do-after 0 [callback result] attempt [close port] port/awake: none ] false ] ] lookup-session-id: none create-session: func [user-id private-ip value] [ append-log 10 ["Creating lookup session for: " user-id] lookup-service compose [create session (user-id) (private-ip) (:value)] func [result] [ all [block? :result parse result [set lookup-session-id integer!]] ] ] renew-lookup-session: has [user-id server-level] [ user-id: get-config/accept 'server-user string! server-level: get-config/default/accept 'server-level 3 integer! if server-level >= 4 [ either lookup-session-id [ append-log 10 "Renewing lookup session" lookup-service compose [renew (lookup-session-id)] none ] [ ; support for testing between intranet hosts will be added later. create-session user-id 127.0.0.1 if-error [ondemand-iperf-server/port-number] [2222] ] ] true ] set-config/catch 'server-user func [user-id] [ append-log 10 "User id was changed" if lookup-session-id [ lookup-service compose [change (lookup-session-id) (user-id) (if-error [ondemand-iperf-server/port-number] [2222])] none ] user-id ] set-config/catch 'server-level func [server-level] [ append-log 10 "Server reporting level was changed" either server-level >= 4 [ if not lookup-session-id [ ; support for testing between intranet hosts will be added later. create-session get-config/accept 'server-user string! 127.0.0.1 if-error [ondemand-iperf-server/port-number] [2222] ] ] [ if lookup-session-id [ lookup-service compose [destroy session (lookup-session-id)] none lookup-session-id: none ] ] server-level ] destroy-lookup-session: does [ if lookup-session-id [ append-log 10 "Destroying lookup session" read/custom get-config/accept/default 'lookup-service-url url! http://iperf1.showcase.surfnet.nl/cgi-bin/lookup.cgi reduce ['post join "destroy session " lookup-session-id] ] ] lookup-name: closure [name' callback] [ lookup-service compose [lookup (name')] func [result /local targets] [ targets: make block! 7 if all [block? result 'KO <> pick result 1] [ foreach [pub priv val] result [ insert tail targets context [ name: name' public-ip: pub private-ip: priv value: :val user-data: none ] ] ] callback targets ] ] current-target: none set-target: func [target [object! none!]] [current-target: target] get-target: does [current-target] export [renew-lookup-session destroy-lookup-session lookup-name set-target get-target] ]