- Publicity: Public Only All
xml-rpc-procs.tcl
Initially created by Dave Bauer 2001-03-30 with inspiration from Steve Ball and help from Aaron Swartz and Jerry Asher.
Modified by Vinod Kurup to
- Use the xml abstraction procs in packages/acs-tcl/tcl/30-xml-utils-procs.tcl (which use tDom now)
- Fit in OpenACS 5 framework
- Location:
- packages/xml-rpc/tcl/xml-rpc-procs.tcl
- Created:
- 2003-09-30
- Author:
- Vinod Kurup [vinod@kurup.com]
- CVS Identification:
$Id: xml-rpc-procs.tcl,v 1.20 2024/09/11 06:15:55 gustafn Exp $
Procedures in this file
- xmlrpc::construct (private)
- xmlrpc::create_context (private)
- xmlrpc::decode_value (private)
- xmlrpc::enabled_p (public)
- xmlrpc::fault (private)
- xmlrpc::get_content (private)
- xmlrpc::httppost (private)
- xmlrpc::invoke (private)
- xmlrpc::invoke_method (private)
- xmlrpc::list_methods (public)
- xmlrpc::parse_response (private)
- xmlrpc::register_proc (public)
- xmlrpc::remote_call (public)
- xmlrpc::respond (private)
- xmlrpc::url (public)
Detailed information
xmlrpc::construct (private)
xmlrpc::construct context arglist
Construct an XML-RPC element.
Example:arglist
is a 2-element list which is converted to XML. The first element ofarglist
is the datatype and the second element is the value.set arglist {-int 33} set result [xmlrpc::construct {} $arglist] set result ==> <i4>33</i4>This proc works recursively, so if your top level list has a list within it, then that list will be processed first. The two examples of this are arrays and structs. In addition, structs and arrays can contain each other.
Array example:set arglist {-array { {-int 6682} {-boolean 0} {-text Iowa} {-double 8931.33333333} {-date {Fri Jan 01 05:41:30 EST 1904}}}} set result [xmlrpc::construct {} $arglist] set result ==> <array> <data> <value> <i4>6682</i4> </value> <value> <boolean>0</boolean> </value> <value> <string>Iowa</string> </value> <value> <double>8931.33333333</double> </value> <value> <dateTime.iso8601>19040101T05:41:30</dateTime.iso8601> </value> </data> </array>Struct Example:
struct
's have the special format:-struct {name1 {-datatype1 value1} name2 {-datatype2 value2}}
set arglist {-struct { ctLeftAngleBrackets {-int 5} ctRightAngleBrackets {-int 6} ctAmpersands {-int 7} ctApostrophes {-int 0} ctQuotes {-int 3}}} set result [xmlrpc::construct {} $arglist] set result ==> <struct> <member> <name>ctLeftAngleBrackets</name> <value> <i4>5</i4> </value> </member> <member> <name>ctRightAngleBrackets</name> <value> <i4>6</i4> </value> </member> <member> <name>ctAmpersands</name> <value> <i4>7</i4> </value> </member> <member> <name>ctApostrophes</name> <value> <i4>0</i4> </value> </member> <member> <name>ctQuotes</name> <value> <i4>3</i4> </value> </member> </struct>The context parameter is used internally to create tags within tags.
Example:set arglist {-int 33} set result [xmlrpc::construct {foo bar} $arglist] set result ==> <foo><bar><i4>33</i4></bar></foo>
- Parameters:
- context (required)
- extra tags to wrap around the data
- arglist (required)
- datatype-value list (or more complex types as described above)
- Returns:
- XML formatted result
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xml_rpc_construct
xmlrpc::create_context (private)
xmlrpc::create_context context value
Return the value wrapped in appropriate context tags. If context is a list of items, then the result will be wrapped in multiple tags. Example:
xmlrpc::create_context {param value} 78 returns ==> "78 "
- Parameters:
- context (required)
- context to create
- value (required)
- character data
- Returns:
- string with value wrapped in context tags
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::decode_value (private)
xmlrpc::decode_value node
Unpack the data in a value element. Most value elements will have a subnode describing the datatype (e.g. <string> or <int>). If no subnode is present, then we should assume the value is a string.
- Parameters:
- node (required)
- <value> node that we're decoding
- Returns:
- Returns the contents of the <value> node. If the value is a <struct> then returns the data in a TCL array. If the value is an <array> then returns the data in a TCL list.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xml_rpc_fault, xml_rpc_decode_value, xml_rpc_respond
xmlrpc::enabled_p (public)
xmlrpc::enabled_p
- Returns:
- whether the server is enabled
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::fault (private)
xmlrpc::fault code msg
Format a fault response to an XML-RPC request
- Parameters:
- code (required)
- error code (integer)
- msg (required)
- error message
- Returns:
- XML-RPC fault message
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xml_rpc_fault
xmlrpc::get_content (private)
xmlrpc::get_content
There's no [ns_conn content] so this is a hack to get the content of the XML-RPC request. Taken from ns_xmlrpc.
- Returns:
- string - the XML request
- Author:
- Dave Bauer
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::httppost (private)
xmlrpc::httppost [ -url url ] [ -timeout timeout ] [ -depth depth ] \ [ -content content ]
The proc util_httppost doesn't work for our needs. We need to send Content-type of text/xml and we need to send a Host header. So, roll our own XML-RPC HTTP POST. Wait - lars-blogger sends out XML-RPC pings to weblogs.com. I'll steal the POST code from there and simplify that call.
- Switches:
- -url (optional)
- -timeout (optional, defaults to
"30"
)- -depth (optional, defaults to
"0"
)- -content (optional)
- Author:
- Vinod Kurup
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::invoke (private)
xmlrpc::invoke xml
Take the XML-RPC request and invoke the method on the server. The methodName element contains the Tcl procedure to evaluate. The method is called from the global stack level.
- Parameters:
- xml (required)
- XML-RPC data from the client
- Returns:
- result encoded in XML and ready for return to the client
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::invoke_method (private)
xmlrpc::invoke_method method_name arguments
Call the given method on the OpenACS server. It's up to the caller to catch any error that we get.
- Parameters:
- method_name (required)
- methodName from XML-RPC
- arguments (required)
- list of arguments
- Returns:
- result of the OpenACS proc
- Author:
- Vinod Kurup
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::list_methods (public)
xmlrpc::list_methods
- Returns:
- alphabetical list of XML-RPC procs on this server
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::parse_response (private)
xmlrpc::parse_response xml
Parse the response from an XML-RPC call.
- Parameters:
- xml (required)
- the XML response
- Returns:
- result
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::register_proc (public)
xmlrpc::register_proc proc_name
Register a proc to be available via XML-RPC.
proc_name
is the name of a proc that is defined in the usual OpenACS way (i.e. ad_proc). Theproc_name
is added to the xmlrpc_procs nsv array with a value of 1. When an XML-RPC call comes in, this array is searched to see if the proc_name has been registered. Currently, the presence ofproc_name
in the nsv is enough to indicate that the proc can be called via XML-RPC. At some point we may allow administrators to disable procs, so we could set the value associated withproc_name
from 1 to 0.
- Parameters:
- proc_name (required)
- Name of proc to be registered.
- Returns:
- nothing
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::remote_call (public)
xmlrpc::remote_call url method [ args ]
Invoke a method on a remote server using XML-RPC
- Parameters:
- url (required)
- url of service
- method (required)
- method to call
- args (optional)
- list of args to the method
- Returns:
- the response of the remote service. Error if remote service returns a fault.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xmlrpc::respond (private)
xmlrpc::respond data
Format a success response to an XML-RPC request
- Parameters:
- data (required)
- data to be returned to the client
- Returns:
- data encoded in a properly formed XML-RPC response
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xml_rpc_respond
xmlrpc::url (public)
xmlrpc::url
- Returns:
- the URL that is listening for RPC requests
- Author:
- Vinod Kurup
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xml_rpc_validate
Content File Source
# /packages/xml-rpc/tcl/xml-rpc-procs.tcl ad_library { <p> Initially created by Dave Bauer 2001-03-30 with inspiration from Steve Ball and help from Aaron Swartz and Jerry Asher. </p> <p> Modified by Vinod Kurup to <ol> <li>Use the xml abstraction procs in packages/acs-tcl/tcl/30-xml-utils-procs.tcl (which use tDom now) </li> <li>Fit in OpenACS 5 framework </li> </ol> </p> @author Vinod Kurup [vinod@kurup.com] @creation-date 2003-09-30 @cvs-id $Id: xml-rpc-procs.tcl,v 1.20 2024/09/11 06:15:55 gustafn Exp $ } # setup nsv array to hold procs that are registered for xml-rpc access nsv_array set xmlrpc_procs [list] namespace eval xmlrpc {} ad_proc -public xmlrpc::url {} { @return the URL that is listening for RPC requests @author Vinod Kurup } { # ok to use this since this is a singleton package. return [apm_package_url_from_key xml-rpc] } ad_proc -public xmlrpc::enabled_p {} { @return whether the server is enabled } { return [parameter::get_from_package_key \ -package_key xml-rpc \ -parameter EnableXMLRPCServer] } ad_proc -public xmlrpc::list_methods {} { @return alphabetical list of XML-RPC procs on this server } { return [lsort [nsv_array names xmlrpc_procs]] } ad_proc -private xmlrpc::get_content {} { There's no [ns_conn content] so this is a hack to get the content of the XML-RPC request. Taken from ns_xmlrpc. @return string - the XML request @author Dave Bauer } { if {[ns_info name] eq "NaviServer"} { # # NaviServer provides a generic means to access the content, # independent from the spooling configuration # set text [ns_getcontent -as_file false -binary false] } else { # (taken from aol30/modules/tcl/form.tcl) # Spool content into a temporary read/write file. # ns_openexcl can fail, since tmpnam is known not to # be thread/process safe. Hence spin till success set fp "" while {$fp eq ""} { set filename "[ad_tmpnam][clock clicks -milliseconds].xmlrpc2" set fp [ns_openexcl $filename] } fconfigure $fp -translation binary ns_conncptofp $fp close $fp set fp [open $filename r] while {![eof $fp]} { append text [read $fp] } close $fp file delete -- $filename } return $text } d_proc -private xmlrpc::fault { code msg } { Format a fault response to an XML-RPC request @param code error code (integer) @param msg error message @return XML-RPC fault message } { # we could build this with the tDom commands, but it's quite a pain # and I don't see the benefit for our simple needs - vinodk set result "<?xml version=\"1.0\"?> <methodResponse> <fault> <value> <struct> <member> <name>faultCode</name> <value><i4>$code</i4></value> </member> <member> <name>faultString</name> <value><string>[ns_quotehtml $msg]</string></value> </member> </struct> </value> </fault> </methodResponse> " # now re-parse and then re-extract to make sure it's well formed set doc [xml_parse -persist $result] if { [catch {xml_doc_render $doc} result] } { return -code error \ "xmlrpc::fault XML is not well formed. error = $result" } xml_doc_free $doc return $result } d_proc -public xmlrpc::register_proc { proc_name } { <p> Register a proc to be available via XML-RPC. <code>proc_name</code> is the name of a proc that is defined in the usual OpenACS way (i.e. ad_proc). The <code>proc_name</code> is added to the xmlrpc_procs nsv array with a value of 1. When an XML-RPC call comes in, this array is searched to see if the proc_name has been registered. Currently, the presence of <code>proc_name</code> in the nsv is enough to indicate that the proc can be called via XML-RPC. At some point we may allow administrators to disable procs, so we could set the value associated with <code>proc_name</code> from 1 to 0. </p> @param proc_name Name of proc to be registered. @return nothing } { nsv_set xmlrpc_procs $proc_name 1 } d_proc -private xmlrpc::decode_value { node } { Unpack the data in a value element. Most value elements will have a subnode describing the datatype (e.g. <string> or <int>). If no subnode is present, then we should assume the value is a string. @param node <value> node that we're decoding @return Returns the contents of the <value> node. If the value is a <struct> then returns the data in a TCL array. If the value is an <array> then returns the data in a TCL list. } { set result "" if {[llength [xml_node_get_children $node]]} { # subnode is specified set subnode [xml_node_get_first_child $node] set datatype [xml_node_get_name $subnode] switch -- $datatype { string - i4 - int - double - base64 { set result [xml_node_get_content $subnode] } boolean { set result [string is true [xml_node_get_content $subnode]] } dateTime.iso8601 { set result [clock scan [string trimright [xml_node_get_content $subnode] Z]] } struct { foreach member \ [xml_node_get_children_by_name $subnode member] { lappend result \ [xml_node_get_content \ [xml_node_get_children_by_name \ $member name]] lappend result \ [xmlrpc::decode_value \ [xml_node_get_children_by_name \ $member value]] } } array { foreach entry [xml_node_get_children \ [xml_node_get_children_by_name \ $subnode data]] { lappend result [xmlrpc::decode_value $entry] } } default { # we received a tag which is not a recognized datatype. ns_log notice xmlrpc::decode_value ignored type: $datatype } } } else { # no datatype subnode, therefore, it's a string set result [xml_node_get_content $node] } return $result } d_proc -private xmlrpc::respond { data } { Format a success response to an XML-RPC request @param data data to be returned to the client @return data encoded in a properly formed XML-RPC response } { set result "<?xml version=\"1.0\"?><methodResponse><params><param><value>" append result [xmlrpc::construct {} $data] append result "</value></param></params></methodResponse>" # now re-parse and then re-extract to make sure it's well formed set doc [xml_parse -persist $result] if { [catch {xml_doc_render $doc} result] } { return -code error \ "xmlrpc::respond XML is not well formed. err = $result" } xml_doc_free $doc return $result } d_proc -private xmlrpc::construct { context arglist } { <p> Construct an XML-RPC element. <code>arglist</code> is a 2-element list which is converted to XML. The first element of <code>arglist</code> is the datatype and the second element is the value. </p> Example: <pre> set arglist {-int 33} set result [xmlrpc::construct {} $arglist] set result ==> <i4>33</i4> </pre> <p> This proc works recursively, so if your top level list has a list within it, then that list will be processed first. The two examples of this are arrays and structs. In addition, structs and arrays can contain each other. </p> Array example: <pre> set arglist {-array { {-int 6682} {-boolean 0} {-text Iowa} {-double 8931.33333333} {-date {Fri Jan 01 05:41:30 EST 1904}}}} set result [xmlrpc::construct {} $arglist] set result ==> <array> <data> <value> <i4>6682</i4> </value> <value> <boolean>0</boolean> </value> <value> <string>Iowa</string> </value> <value> <double>8931.33333333</double> </value> <value> <dateTime.iso8601>19040101T05:41:30</dateTime.iso8601> </value> </data> </array> </pre> <p> <code>struct</code>'s have the special format: <code>-struct {name1 {-datatype1 value1} name2 {-datatype2 value2}}</code> </p> Struct Example: <pre> set arglist {-struct { ctLeftAngleBrackets {-int 5} ctRightAngleBrackets {-int 6} ctAmpersands {-int 7} ctApostrophes {-int 0} ctQuotes {-int 3}}} set result [xmlrpc::construct {} $arglist] set result ==> <struct> <member> <name>ctLeftAngleBrackets</name> <value> <i4>5</i4> </value> </member> <member> <name>ctRightAngleBrackets</name> <value> <i4>6</i4> </value> </member> <member> <name>ctAmpersands</name> <value> <i4>7</i4> </value> </member> <member> <name>ctApostrophes</name> <value> <i4>0</i4> </value> </member> <member> <name>ctQuotes</name> <value> <i4>3</i4> </value> </member> </struct> </pre> <p> The context parameter is used internally to create tags within tags. </p> Example: <pre> set arglist {-int 33} set result [xmlrpc::construct {foo bar} $arglist] set result ==> <foo><bar><i4>33</i4></bar></foo> </pre> @param context extra tags to wrap around the data @param arglist datatype-value list (or more complex types as described above) @return XML formatted result } { set result "" # list of valid options set options_list [list "-string" "-text" "-i4" "-int" "-integer" \ "-boolean" "-double" "-date" "-binary" "-base64" \ "-variable" "-structvariable" "-struct" \ "-array" "-keyvalue"] # if no valid option is specified, treat it as string if {[lsearch $options_list [lindex $arglist 0]] == -1} { set value "<string>[ns_quotehtml $arglist]</string>" return [xmlrpc::create_context $context $arglist] } if { [llength $arglist] % 2} { # datatype required for each value return -code error \ "no value for option \"[lindex $arglist end]\"" } foreach {option value} $arglist { switch -- $option { -string - -text { set value "<string>[ns_quotehtml $value]</string>" append result [xmlrpc::create_context $context $value] } -i4 - -int - -integer { if {![string is integer $value]} { return -code error \ "value \"$value\" for option \"$option\" is not an integer:" } set value "<i4>$value</i4>" append result [xmlrpc::create_context $context $value] } -boolean { set value "<boolean>[string is true $value]</boolean>" append result [xmlrpc::create_context $context $value] } -double { if {![string is double $value]} { return -code error \ "value \"$value\" for option \"$option\" is not a floating point value" } set value "<double>$value</double>" append result [xmlrpc::create_context $context $value] } -date { if {[catch {clock format [clock scan $value] \ -format {%Y%m%dT%T} } datevalue]} { return -code error \ "value \"$value\" for option \"$option\" is not a valid date ($datevalue)" } set value "<dateTime.iso8601>$datevalue</dateTime.iso8601>" append result [xmlrpc::create_context $context $value] } -binary - -base64 { # it is up to the application to do the encoding # before the data gets here set value "<base64>$value</base64>" append result [xmlrpc::create_context $context $value] } -array { set data "<array><data>" foreach datum $value { append data [xmlrpc::construct value $datum] } append data "</data></array>" append result [xmlrpc::create_context $context $data] } -struct - -keyvalue { set data "<struct>" foreach {name mvalue} $value { append data "<member><name>[ns_quotehtml $name]</name>" append data [xmlrpc::construct value $mvalue] append data "</member>" } append data "</struct>" append result [xmlrpc::create_context $context $data] } default { # anything else will be ignored ns_log notice xmlrpc::construct ignored option: $option \ with value: $value } } } return $result } d_proc -private xmlrpc::create_context { context value } { Return the value wrapped in appropriate context tags. If context is a list of items, then the result will be wrapped in multiple tags. Example: <pre> xmlrpc::create_context {param value} 78 returns ==> "<param><value>78</value></param>" </pre> @param context context to create @param value character data @return string with value wrapped in context tags } { # reverse the list (algorithm from TCL Wiki) set r_context {} set i [llength $context] while {$i} {lappend r_context [lindex $context [incr i -1]]} set result "$value" foreach child_name $r_context { set result "<$child_name>$result</$child_name>" } return $result } d_proc -public xmlrpc::remote_call { url method {args ""} } { Invoke a method on a remote server using XML-RPC @param url url of service @param method method to call @param args list of args to the method @return the response of the remote service. Error if remote service returns a fault. } { set call "<?xml version=\"1.0\"?><methodCall><methodName>$method</methodName>" append call "<params>" if { [llength $args] } { append call [xmlrpc::construct {param value} $args] } append call "</params></methodCall>" # now re-parse and then re-extract to make sure it's well formed set doc [xml_parse -persist $call] if { [catch {xml_doc_render $doc} request] } { return -code error \ "xmlrpc::fault XML is not well formed. error = $request" } xml_doc_free $doc # make the call if {[catch {xmlrpc::httppost -url $url -content $request } response ]} { ns_log error xmlrpc::remote_call \ url: $url request: $request error: $response return -code error [list HTTP_ERROR \ "HTTP request failed due to \"$response\""] } return [xmlrpc::parse_response $response] } d_proc -private xmlrpc::httppost { -url {-timeout 30} {-depth 0} -content } { The proc util_httppost doesn't work for our needs. We need to send Content-type of text/xml and we need to send a Host header. So, roll our own XML-RPC HTTP POST. Wait - lars-blogger sends out XML-RPC pings to weblogs.com. I'll steal the POST code from there and simplify that call. @author Vinod Kurup } { if {[incr depth] > 10} { return -code error "xmlrpc::httppost: Recursive redirection: $url" } set req_hdrs [ns_set create] # headers necessary for a post and the form variables ns_set put $req_hdrs Accept "*/*" ns_set put $req_hdrs User-Agent "[ns_info name]-Tcl/[ns_info version]" ns_set put $req_hdrs "Content-type" "text/xml" ns_set put $req_hdrs "Content-length" [string length $content] set r [util::http::post -body $content -url $url -headers $req_hdrs] set headers [dict get $r headers] set status [dict get $r status] # follow 302 if {$status == 302} { set location [expr {[dict exists $headers location] ? [dict get $headers location] : ""}] if {$location ne ""} { ns_set free $headers close $rfd set page [xmlrpc::httppost -url $location \ -timeout $timeout -depth $depth -content $content] } } return [dict get $r page] } ad_proc -private xmlrpc::parse_response {xml} { Parse the response from an XML-RPC call. @param xml the XML response @return result } { set doc [xml_parse -persist $xml] set root [xml_doc_get_first_node $doc] if { [xml_node_get_name $root] ne "methodResponse" } { set root_name [xml_node_get_name $root] xml_doc_free $doc return -code error "xmlrpc::parse_response: invalid server response - root node is not methodResponse. it's $root_name" } set node [xml_node_get_first_child $root] switch -- [xml_node_get_name $node] { params { # need more error checking here. # if the response is not well formed, we'll probably # get an error, but it may be hard to track down set param [xml_node_get_first_child $node] set value [xml_node_get_first_child $param] set result [xmlrpc::decode_value $value] } fault { # should do more checking here... array set fault [xmlrpc::decode_value \ [xml_node_get_first_child $node]] xml_doc_free $doc return -code error -errorcode $fault(faultCode) $fault(faultString) } default { set type [xml_node_get_name $node] xml_doc_free $doc return -code error "xmlrpc::parse_response: invalid server response ($type)" } } xml_doc_free $doc return $result } d_proc -private xmlrpc::invoke { xml } { Take the XML-RPC request and invoke the method on the server. The methodName element contains the Tcl procedure to evaluate. The method is called from the global stack level. @param xml XML-RPC data from the client @return result encoded in XML and ready for return to the client } { # check that the XML-RPC Server is enabled if { ![xmlrpc::enabled_p] } { set result [xmlrpc::fault 3 "XML-RPC Server disabled"] ns_log error "xmlrpc::invoke fault $result" return $result } # check that the provided XML is nonempty if { $xml eq "" } { set result [xmlrpc::fault 3 "Empty XML document passed to XML-RPC"] ns_log error "xmlrpc::invoke fault $result" return $result } ns_log debug "xmlrpc::invoke REQUEST: $xml" if {[catch {set doc [xml_parse -persist $xml]} err_msg]} { set result [xmlrpc::fault 1 "error parsing request: $err_msg"] ns_log error "xmlrpc::invoke: error parsing request: $err_msg" } else { # parse OK - get data set data [xml_doc_get_first_node $doc] set method_name \ [xml_node_get_content \ [lindex \ [xml_node_get_children_by_name $data methodName] 0 ]] set arguments [list] set params [xml_node_get_children_by_name $data params] if {$params ne ""} { foreach parameter [xml_node_get_children_by_name $params param] { lappend arguments \ [xmlrpc::decode_value [xml_node_get_first_child $parameter]] } } set errno [catch {xmlrpc::invoke_method $method_name $arguments} result] if { $errno } { set result [xmlrpc::fault $errno $result] global errorInfo ns_log error "xmlrpc_invoke: error in xmlrpc method REQUEST: $xml RESULT: $result\n$errorInfo" } else { # success set result [xmlrpc::respond $result] ns_log debug "xmlrpc::invoke result $result" } } if {[info exists doc]} { xml_doc_free $doc } return $result } d_proc -private xmlrpc::invoke_method { method_name arguments } { Call the given method on the OpenACS server. It's up to the caller to catch any error that we get. @param method_name methodName from XML-RPC @param arguments list of arguments @return result of the OpenACS proc @author Vinod Kurup } { # check that the method is registered as a valid XML-RPC method if {![nsv_exists xmlrpc_procs $method_name]} { return -code error -errorcode 2 "methodName $method_name doesn't exist" } ns_log debug "xmlrpc::invoke_method method $method_name args $arguments" set result [uplevel #0 [list $method_name] $arguments] return $result } # # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: