1# tclserver.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com> 2# 3# Provide webservices from tclhttpd using the SOAP::CGI package. 4# This is equivalent to the `rpc' script in cgi-bin that provides the same 5# webservices via CGI. 6# 7# TODO: 8# This should be optimised somewhat. At the moment we are sourceing the 9# service implementation files each time a request arrives ala. CGI. However, 10# running under tclhttpd we are using the _same_ process each time. So 11# we should source the implementations _one_ time and then simply call the 12# procedures in the correct namespace. 13# This might need some refactoring in SOAP-CGI.tcl. 14# 15# 16# $Id: tclserver.tcl,v 1.2 2001/08/05 22:54:25 patthoyts Exp $ 17 18package require SOAP::CGI 19 20# Set to the cgi-bin or wherever. 21set root [file join $::env(HOME) lib tcl tclsoap cgi-bin] 22 23set SOAP::CGI::soapdir [file join $root soap] 24set SOAP::CGI::soapmapfile [file join $root soapmap.dat] 25set SOAP::CGI::xmlrpcdir [file join $root soap] 26set SOAP::CGI::xmlrpcmapfile [file join $root xmlrpcmap.dat] 27catch {unset SOAP::CGI::logfile} 28 29Url_PrefixInstall /RPC rpc_handler 30 31proc rpc_handler {sock args} { 32 upvar \#0 Httpd$sock data 33 34 if {[catch { 35 set query $data(query) 36 set doc [dom::DOMImplementation parse $query] 37 38 if {[SOAP::CGI::selectNode $doc "/Envelope"] != {}} { 39 set result [SOAP::CGI::soap_invocation $doc] 40 } elseif {[SOAP::CGI::selectNode $doc "/methodCall"] != {}} { 41 set result [SOAP::CGI::xmlrpc_invocation $doc] 42 } 43 44 Httpd_ReturnData $sock text/xml $result 200 45 } err]} { 46 Httpd_ReturnData $sock text/xml $err 500 47 } 48} 49