Index: ns_xmlrpc/README
===================================================================
RCS file: /usr/local/cvsroot/ns_xmlrpc/README,v
diff -u -r1.1 -r1.2
--- ns_xmlrpc/README	3 Jul 2001 17:45:43 -0000	1.1
+++ ns_xmlrpc/README	11 Jul 2001 15:44:34 -0000	1.2
@@ -1 +1,42 @@
-RBM: Placeholder file for the ns_xmlrpc module. Change this later :)
+ns_xmlrpc -- 	adds XML-RPC server and client features to
+		AOLserver/OpenACS
+
+Requirements: 	ns_xml 1.3
+		AOLserver 3. using nsd8x
+		OpenACS 3.2.5 
+
+Setup:	Copy the Tcl files into your private Tcl library, ie. /web/yoursite/tcl
+	and start/restart AOLserver
+
+	To test the server go to http://validator.xmlrpc.com. Enter the 
+	domain of your server and click the validate button. Hopefully
+	everything works. If it doesn't, check your server error log.
+
+	Call xmlrpc_register_proc with the procedure name for every Tcl
+	procedure you want to be made available via XML-RPC.
+
+How it works: 	A registered proc is setup in validator.tcl that sends all
+		HTTP requests to /RPC2 to the XML-RPC handler. It checks to 
+		make sure the methodName is registered as available via 
+		XML-RPC. If the methodName is valid the XML-RPC request is
+		parsed and the parameters are passed to the procedure.
+
+		The procedure does whatever processing is necessary and returns
+		a result to the XML-RPC handler which builds an XML-RPC
+		methodResponse and returns it.
+
+Credits:	Ns_xml conversion by Dave Bauer (dave@thedesignexperience.org)
+		with help from Jerry Asher (jerry@theashergroup.com). 
+		This code is based on the original Tcl-RPC by Steve Ball
+		with contributions by Aaron Swartz. The original Tcl-RPC
+		uses TclXML and TclDOM to parse the XML. It works fine but
+		since OpenACS-4 will use ns_xml I converted it. 
+		
+Reference:	XML-RPC spec: http://www.xmlrpc.com/spec
+		OpenACS: http://openacs.org
+		AOLserver: http://www.aolserver.com	
+		OpenNSD: http://www.opennsd.org
+		ns_xml: http://acs-misc.sourceforge.net
+
+
+
Index: ns_xmlrpc/ns_xmlrpc.tcl
===================================================================
RCS file: /usr/local/cvsroot/ns_xmlrpc/ns_xmlrpc.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ ns_xmlrpc/ns_xmlrpc.tcl	11 Jul 2001 15:44:34 -0000	1.1
@@ -0,0 +1,541 @@
+ns_log notice "Loading ns_xml-rpc.tcl"
+
+# ns_xml-rpc 2001/03/30
+# xml-rpc server and client implementation for AOLserver/OpenNSD
+# with ns_xml module
+# Dave Bauer dave@thedesignexperience.org
+# taken from xmlrpc.tcl from Steve Ball
+
+#
+# setup nsv array to hold procs that are registered for xmlrpc
+
+nsv_array set xmlrpc_procs [list]
+
+
+# xmlrpc_register_proc
+# 
+# register a proc to be available via XML-RPC
+# 
+# for now you have to call xmlrpc_register_proc for every
+# proc that you want to be available
+# 
+
+proc xmlrpc_register_proc {proc_name} {
+    nsv_set xmlrpc_procs $proc_name $proc_name
+}
+
+# xmlrpc_respond
+#
+# format a sucess response to a XML-RPC request
+#
+# Arguments
+#   data   data to be returned to the client
+#
+# Results
+#   return appropriately formatted text
+#
+
+proc xmlrpc_respond {data} {
+    set response  [ns_xml doc create "1.0"]
+    set doc_id    [ns_xml doc new_root $response methodResponse ""]
+    set params_id [ns_xml node new_child $doc_id params ""]
+    set param_id  [ns_xml node new_child $params_id param ""]
+    set value_id  [ns_xml node new_child $param_id value ""]
+    
+    xmlrpc_construct $value_id {} $data
+
+    set result [ns_xml doc render $response]
+    ns_xml doc free $response
+
+    return $result
+}
+
+
+# xmlrpc_fault
+#   format a fault response to a XML-RPC request
+#
+# Arguments
+#   code  error code
+#   msg   error message
+#
+# Results
+#   returns appropriately formatted text
+#
+
+proc xmlrpc_fault {code msg} {
+
+    set response [ns_xml doc create "1.0"]
+    set value \
+            [ns_xml node new_child \
+                [ns_xml node new_child \
+                [ns_xml doc new_root $response methodResponse ""] \
+                fault ""] value ""]
+
+    set struct [ns_xml node new_child $value struct ""]
+    set codemember [ns_xml node new_child $struct member ""]
+    ns_xml node new_child \
+            [ns_xml node new_child $codemember value ""] \
+            int $code
+    set msgmember [ns_xml node new_child $struct member ""]
+    ns_xml node new_child \
+            [ns_xml node new_child $msgmember value ""] \
+            string $msg
+
+    set result [ns_xml doc render $response]
+
+    ns_xml doc free $response
+
+    return $result
+}
+
+# xmlrpc_invoke
+#
+# the methodName element contains the Tcl procedure to evaluate
+# the parameters are passed as arguments to the global eval
+#
+# Arguments
+#   xml     XML-RPC data from the client
+#   
+# Results
+#   return value of the method is encoded ready for return to
+#   the client
+#
+
+proc xmlrpc_invoke {xml} {
+
+    if {[catch {ns_xml parse $xml} doc_id]} {
+        set result [xmlrpc_fault 1 "error parsing request: $doc_id"]
+        ns_log error "xmlrpc_invoke: error parsing request: $doc_id"
+    } else {
+        set data   [ns_xml doc root $doc_id]
+        set methodName \
+            [ns_xml node getcontent \
+              [lindex \
+                [ns_xml_getElementsByTagName $data methodName] 0 ]]
+
+# check that the method is registered as a  valid XML-RPC method 
+#
+	
+	if {![nsv_exists xmlrpc_procs $methodName]} {
+	     set result [xmlrpc_fault "00" "methodName does not exist"]
+	     return $result
+	    }
+
+        set arguments [list]
+        set params [ns_xml_getElementsByTagName $data params]
+        foreach parameter \
+                [ns_xml_getElementsByTagName $params param] {
+
+            lappend arguments \
+              [xmlrpc_decodeValue \
+                 [lindex [ns_xml_getChildrenTrim $parameter] 0]]
+        }
+    
+        if {[catch {uplevel #0 [list $methodName] $arguments} result]} {
+        # don't ask me what the $:: means
+            set result [xmlrpc_fault "1" $result]
+            ns_log error "xmlrpc_invoke: error in xmlrpc method $methodName $result"
+        } else {
+            set result [xmlrpc_respond $result]
+        }
+    }
+    return $result
+}
+
+
+
+# xmlrpc_createContext
+#
+#   create a container element for data
+#
+#   Arguments
+#
+#     parent  parent node
+#
+#     context context to create 
+#
+# 
+proc xmlrpc_createContext { parent context } {
+    
+    foreach child $context {
+        set parent \
+                [ns_xml node new_child $parent $child ""]
+    }
+
+    return $parent
+}
+
+# xmlrpc_callResponse
+#
+# Arguments
+#   request HTTP request token
+#
+# Result
+#   returns the result of the XML-RPC request
+
+proc xmlrpc_callResponse {response} {
+    # ns_log debug xmlrpc_CallResponse response \"$response\"
+    if {[catch {xmlrpc_parse $response} result]} {
+        return -code error \
+                "XMLRPC-ERROR remote procedure call failed: \"$result\""
+    }
+  
+    return $result
+}
+
+# xmlrpc_call
+#
+# invoke a method on the remote server using XML-RPC
+#
+# Arguments
+#   url     url of service
+#   method  method to call
+#   args    args to the method
+#
+# Results
+#   return the response of the service or an error if
+#   the service returns a fault
+
+proc xmlrpc_call {url method args} {
+    set rpc [ns_xml doc create "1.0"]
+    set cleanup [list ns_xml doc free $rpc]
+    set call [ns_xml doc new_root $rpc methodCall ""]
+    ns_xml node new_child $call methodName $method
+    
+    set params [ns_xml node new_child $call params ""]
+
+    if {[catch {
+        xmlrpc_construct $params {param value} $args
+    } errMsg]} {
+        eval $cleanup
+        return -code error $errMsg
+    }
+
+    #make the call
+    # experimental, how can we use util_httppost 
+    
+    if {[catch {
+        set request [ns_xml doc render $rpc]
+        # ns_log debug xmlrpc_call url $url request \"$request\"
+        util_httppost $url $request
+    } response ]} {
+        eval $cleanup
+        ns_log error xmlrpc_call url $url methodName $method error: $response
+        return -code error \
+                [list HTTP_ERROR \
+                "HTTP request failed due to \"$response\""]
+    }
+
+    eval $cleanup
+    # skip over httpoptions part...
+    # that is for the HTTP package for Tcl
+
+    return [xmlrpc_callResponse $response]
+}
+
+
+
+# xmlrpc_construct --
+#
+#     Construct the XML-RPC resquest or response
+#
+# Arguments
+#     node node to add child elements to
+#     context     how to add the data
+#     arglist     configuration options?
+#
+# Results
+#     Nodes added to document tree. Returns unrecognized options
+#
+
+proc xmlrpc_construct { node context arglist } {
+    set unused {}
+    # consume string arguments until configuration options found 
+
+    while {[llength $arglist] && \
+            ![string match -* [lindex $arglist 0]]} {
+
+        ns_xml node setcontent \
+                [xmlrpc_createContext $node $context] \
+                [lindex $arglist 0]
+        set arglist [lreplace $arglist 0 0]
+    }
+
+    # Now process configuration options
+    
+    if { [llength $arglist] % 2} {
+        return -code error \
+                "no value for option \"[lindex $arglist end]\""
+    }
+    
+    foreach {option value} $arglist {
+        switch -- $option {
+            -string -
+            -text {
+                ns_xml node setcontent \
+                        [xmlrpc_createContext $node $context] \
+                        $value
+            }
+
+            -i4 -
+            -int -
+            -integer {
+                if {![string is integer $value]} {
+                    return -code error \
+                            "value \"$value\" for option \"$option\" is not an integer:"
+                }
+                ns_xml node new_child \
+                        [xmlrpc_createContext $node $context] \
+                        i4 $value
+            }
+
+            -boolean {
+                ns_xml node new_child \
+                        [xmlrpc_createContext $node $context] \
+                        boolean [string is true $value]
+            }
+
+            -double {
+                if {![string is double $value]} {
+                    return -code error \
+                            "value \"$value\" for option \"$option\" is not a floating point value"
+                }
+                ns_xml node new_child \
+                        [xmlrpc_createContext $node $context] \
+                        double $value
+            }
+
+            -date {
+
+                if {[catch {
+                    clock format [clock scan $value] \
+                          -format {%Y%m%dT%H:%M:%S}
+                } datevalue]} {
+                    return -code error \
+                            "value \"$value\" for option \"$option\" is not a valid date ($datevalue)"
+                }
+                
+                ns_xml node new_child \
+                        [xmlrpc_createContext $node $context] \
+                        "dateTime.iso8601" $datevalue
+            }
+
+            -binary -
+            -base64 {
+                
+                # it is up to the application to do the
+                # encoding, I think it's built into AOLserver.. 
+                # anyway it should be done before the 
+                # data is sent here
+
+                ns_xml node new_child \
+                        [xmlrpc_createContext $node $context] \
+                        base64 $value
+
+            }
+
+            -variable {
+                
+                upvar 2 $value var
+                if {[array exists var]} {
+                    set data nx_xml node new_child \
+                        [ns_xml node new_child \
+                            [xmlrpc_createContext $node $context] \
+                                array "" ] data "" ]
+
+                    foreach {idx entry [array get var]} {
+                        nx_xml node new_child $data value $entry
+                    }
+                } else {
+                    ns_xml node setcontent \
+                        [xmlrpc_createContext $node $context] \
+                        $value 
+            }   
+        }
+
+        -structvariable {
+            
+            upvar 2 $value var
+            set struct [ns_xml node new_child \
+                [xmlrpc_createContext $node $context] $struct ""]
+           
+            foreach [idx entry] [array get var] {
+                set member \
+                        [ns_xml node newchild $struct member ""]
+                ns_xml node newchild $member name $idx
+                ns_xml node newchild $member value $entry
+            }
+        }
+
+        -array {
+
+            set data \
+              [ns_xml node new_child \
+                [ns_xml node new_child \
+                   [xmlrpc_createContext $node $context] \
+                   array ""] \
+                data ""]
+            foreach datum $value {
+                set result [xmlrpc_construct $data value $datum]
+                if {[llength $result]} {
+                    return -code error \
+                            "unknown configuration option \"[lindex $result 0]\""
+                }
+            }
+        }
+
+        -struct -
+        -keyvalue {
+            set struct \
+                    [ns_xml node new_child \
+                    [xmlrpc_createContext $node $context] \
+                    struct ""]
+            foreach {name mvalue} $value {
+                set member \
+                    [ns_xml node new_child $struct member ""]
+                ns_xml node new_child $member name $name
+                set result \
+                        [xmlrpc_construct $member value $mvalue]
+                if {[llength $result]} {
+                    return -code error \
+                            "unkown configuration option \"[lindex $result 0]\""
+                }
+            }
+        }
+
+        default {
+            #anything else will be passed back
+            lappend unused $option $value
+        }
+    }
+}
+
+return $unused
+}
+
+
+# xmlrpc_decodeValue
+#   Unpack the data in a value element
+#
+# Arguments 
+#   node   value element node
+#
+# Results
+#   Returns data. If the value is a struct then returns the data
+#   in name-value pairs. If the value is an array then returns
+#   the data as name-value pairs where the name is an integer
+#   starting with 0.
+
+proc xmlrpc_decodeValue {node} {
+
+    set result ""
+
+    if {[llength [ns_xml node children $node]] != 0} {  
+
+        set nodeType [ns_xml node type [ns_xml_firstChild $node]]
+        # ns_log debug decodeValue nodeType $nodeType
+        switch -- $nodeType {
+            cdata_section {
+                set result \
+                        [ns_xml node getcontent \
+                        [ns_xml_firstChild  $node]]
+                # ns_log debug cdata result $result
+            }
+            
+            attribute {
+                set attrType [ns_xml node name \
+                        [ns_xml_firstChild $node]] 
+                switch -- $attrType {
+                    string -
+                    i4 -
+                    int -
+                    double -
+                    boolean  {
+                        
+                        set result \
+                                [ns_xml node getcontent \
+                                [ns_xml_firstChild $node]]
+                    }
+                    
+                    dateTime.iso8601 {
+                        set result \
+                                [clock scan \
+                                [ns_xml node getcontent \
+                                [ns_xml_firstChild $node]]]
+                    }
+                    
+                    base64 {
+                        set result \
+                                [ns_xml node getcontent \
+                                [ns_xml_firstChild $node]]
+                    }
+                    
+                    struct {
+                        foreach member \
+                                [ns_xml_getElementsByTagName \
+                                [ns_xml_firstChild $node] member] {
+                            lappend result \
+                                    [ns_xml node getcontent \
+                                    [ns_xml_getElementsByTagName \
+                                    $member name]]
+                            set stuff \
+                                    [xmlrpc_decodeValue \
+                                    [ns_xml_getElementsByTagName \
+                                    $member value]]
+#                              ns_log notice "XMLRPC:stuff:$stuff"
+			    lappend result $stuff
+			}
+		    }
+
+		    array {
+			set index 0
+
+			foreach entry \
+				[ns_xml_getChildrenTrim \
+				[ns_xml_getElementsByTagName \
+				[ns_xml_firstChild $node] data ]]  {
+			    lappend result [incr index]
+			    lappend result \
+				    [xmlrpc_decodeValue $entry]
+			}
+		    }
+		    
+		}
+	    }
+	    
+	    default {
+		ns_log notice "XMLRPC:decode:node type not found"
+	    }
+	    
+	}
+    }
+    return $result
+}
+
+proc xmlrpc_parse {xml} {
+
+    set doc_id [ns_xml parse $xml]
+    set response [ns_xml doc root $doc_id]
+    set top [ns_xml_firstChild $response]
+    switch -- [ns_xml node name $top] {
+        params {
+            set param [ns_xml_firstChild $top]
+            #the above should be checked: node type, tag names, etc...
+            set firstChild [ns_xml_firstChild $param]
+            set result [xmlrpc_decodeValue $firstChild]
+        }
+        fault {
+            # should do more checking here...
+            # does value/struct/member, etc, exist? and so on
+            array set fault [xmlrpc_decodeValue [ns_xml_firstChild $top]]
+            return -code error [list $fault(faultCode) $fault(faultString)]
+        }
+        default {
+            set type [ns_xml node name $response]
+            return -code error "invalid server reposnse ($type)"
+        }
+    }
+    return $result
+}
+
+ns_log notice "Done ns_xml-rpc.tcl"
Index: ns_xmlrpc/validator.tcl
===================================================================
RCS file: /usr/local/cvsroot/ns_xmlrpc/validator.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ ns_xmlrpc/validator.tcl	11 Jul 2001 15:44:34 -0000	1.1
@@ -0,0 +1,334 @@
+# XML-RPC Validation Test
+# Written by, Aaron Swartz <aaron@theinfo.org>
+# Enhanced by Jerry Asher <jerry@theashergroup.com>
+# contains:
+#   xml-rpc query dispatcher (registered proc)
+#   xml-rpc client validator test implementation
+#   xml-rpc server validation implementation
+
+############################################################
+
+# For some reason, AOLserver doesn't have an [ns_conn content]
+# function.  It looks a bit like it was taken out at the last
+# minute.  I have to talk about the AOLserver people about this.
+# In the meantime, I have this hack that does the same:
+
+proc getContent {} {
+
+    # (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 == ""} {
+        set filename "[ns_tmpnam][clock clicks].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
+    ns_unlink $filename
+    return $text
+}
+
+proc xml_rpcdispatcher {} {
+    if {[ns_conn method] == "GET"} {
+        ns_return 200 text/html "XML-RPC Validator App
+        <p>This is an
+        <a href=\"http://xml-rpc.com\">XML-RPC</a> application.
+        If you want to use it, try a POST request.
+        </p>
+        "
+    } else {
+        global content
+        set content [getContent]
+        ns_return 200 text/xml [xmlrpc_invoke $content]
+    }
+}
+
+ns_register_proc GET  /RPC2 xml_rpcdispatcher
+ns_register_proc POST /RPC2 xml_rpcdispatcher
+
+############################################################
+# The xml-rpc client validator procedures begin here:
+
+# Takes an array, each of whose members is a struct.  Return the
+# sum of all the values named curly from each struct.
+
+proc validator1.arrayOfStructsTest {params} {
+        
+    set number 0
+    foreach {ignore param} $params {
+        array set struct $param
+        set number [expr $number + $struct(curly)]
+    }
+    return [list -int $number]
+
+    # Turn the list-ified array into a normal array (bigArray)
+    array set bigArray [lindex $args 0]
+    
+    set counter 1
+    set number 0
+    # Loop
+    while {[info exists bigArray($counter)]} {
+        # De-list-ify the struct:
+        array set struct $bigArray($counter)
+        # Add curly to the number count:
+        set number [expr $number + $struct(curly)]
+        # Increment the counter before going on:
+        incr counter
+    }
+    # Return the number count as an integer:
+    return [list -int $number]
+}
+
+# Takes a string.
+# Return the number of each entity in a struct.
+
+proc validator1.countTheEntities {args} {
+    # HACK: The XML-RPC parse doesn't deal with entities
+    # very well. Instead, we get things directly.
+
+    global content
+    regexp {<value>(.*)</value>} $content {} string
+    set string [util_expand_entities $string]
+        
+    # NORMAL VERSION: 
+    #set string $args
+        
+    # For each type of entity, do a regsub -all and return the result as an integer,
+    # then place it all in a struct with the proper names and return it.
+    return \
+      [list -struct \
+        [list \
+          ctLeftAngleBrackets  [list -int [regsub -all {\<} $string "" string]] \
+          ctRightAngleBrackets [list -int [regsub -all {\>} $string "" string]] \
+          ctAmpersands         [list -int [regsub -all {&}  $string "" string]] \
+          ctApostrophes        [list -int [regsub -all {\'} $string "" string]] \
+          ctQuotes             [list -int [regsub -all {\"} $string "" string]]]]
+}
+
+# Takes a struct.
+# Return the sum of the values larry, curly and moe.
+
+proc validator1.easyStructTest {struct} {
+    # De-list-ify the stuct:
+    array set bigStruct $struct
+    # Return the sum as an integer:
+    return [list -int [expr \
+            $bigStruct(moe) \
+            + $bigStruct(curly) \
+            + $bigStruct(larry)]]
+}
+
+proc validator1.echoStructTest {struct} {
+    foreach {name value} $struct {
+        if {[llength $value] > 1} {
+            # For the substructs:
+            foreach {name2 value2} $value {
+                set returnArray($name2) [list -int $value2]
+            }
+            set output($name) [list -struct [array get returnArray]]
+        } else {
+            set output($name) $value
+        }
+        array set returnArray ""
+    }
+    return [list -struct [array get output]]
+}
+
+proc validator1.manyTypesTest {
+    number boolean string double dateTime base64
+} {
+    return [list -array \
+             [list \
+               [list -int $number] \
+               [list -boolean $boolean] \
+               [list -text $string] \
+               [list -double $double] \
+               [list -date [clock format $dateTime]] \
+               [list -base64 $base64]]]
+}
+
+proc validator1.moderateSizeArrayCheck {array} {
+    array set bigArray $array
+    set counter 1
+    while {[info exists bigArray($counter)]} {
+        incr counter
+    }
+    set counter [expr $counter - 1]
+    return "-string [list "$bigArray(1)$bigArray($counter)"]"
+}
+
+proc validator1.nestedStructTest {struct} {
+    array set bigStruct $struct
+    array set 2000 $bigStruct(2000)
+    array set April $2000(04)
+    array set first $April(01)
+    return "-int [expr $first(larry) \
+            + $first(curly) + $first(moe)]"
+}
+
+proc validator1.simpleStructReturnTest {number} {
+    set struct(times10) [expr $number * 10]
+    set struct(times100) [expr $number * 100]
+    set struct(times1000) [expr $number * 1000]
+
+    return "-struct [list [array get struct]]"
+}
+
+############################################################
+# XML-RPC Server Validator
+
+proc validate1.arrayOfStructsTest {
+    {url http://www.theashergroup.com/RPC2}
+    {array ""}
+} {
+    if {[string equal "" $array]} {
+        set array [list \
+              [list -struct [list moe [list -int 1] \
+                                  curly [list -int 2] \
+                                  larry [list -int 3]]] \
+              [list -struct [list moe [list -int 1] \
+                                  curly [list -int 2] \
+                                  larry [list -int 3]]] \
+              [list -struct [list moe [list -int 1] \
+                                  curly [list -int 2] \
+                                  larry [list -int 3]]]]
+    }
+    return [xmlrpc_call $url validator1.arrayOfStructsTest -array $array]
+}
+
+proc validate1.countTheEntities {
+    {url http://www.theashergroup.com/RPC2}
+    {string {<<<>>>}}
+} {
+    set response \
+          [xmlrpc_call \
+            $url validator1.countTheEntities -string $string]
+    return $response
+}
+
+proc validate1.easyStructTest {
+    {url "http://www.theashergroup.com/RPC2"}
+    {struct ""}
+} {
+    if {[string equal "" $struct]} {
+        set struct \
+              [list moe [list -int 1] \
+                    curly [list -int 2] \
+                    larry [list -int 3]]
+
+    }
+    return [xmlrpc_call $url validator1.easyStructTest -struct $struct]
+}
+
+proc validate1.echoStructTest {
+    {url "http://www.theashergroup.com/RPC2"}
+    {struct ""}
+} {
+    if {[string equal $struct ""]} {
+        set struct [list bob [list -int 5]]
+    }
+    return [xmlrpc_call $url validator1.echoStructTest -struct $struct]
+}
+
+proc validate1.manyTypesTest {
+    {url http://www.theashergroup.com/RPC2}
+    {int 1} 
+    {boolean 0}
+    {string wazzup}
+    {double 3.14159}
+    {date "20010704T11:50:30"}
+    {base64 "R0lGODlhFgASAJEAAP/////OnM7O/wAAACH5BAEAAAAALAAAAAAWABIAAAJAhI+py40zDIzujEDBzW0n74AaFGChqZUYylyYq7ILXJJ1BU95l6r23RrRYhyL5jiJAT/Ink8WTPoqHx31im0UAAA7"}
+} {
+    return [xmlrpc_call $url validator1.manyTypesTest \
+              -int $int -boolean $boolean -string $string \
+              -double $double -date $date -base64 $base64]
+}
+
+proc validate1.moderateSizeArrayCheck {
+    {url http://www.theashergroup.com/RPC2}
+    {first "Now is the time for all good men "}
+    {last "to come to the aid of their country"}
+    {fluff_length 20}
+} {
+    set array [list]
+
+    lappend array [list -string $first]
+    for {set i 0} {$i < $fluff_length} {incr i} {
+        lappend array [list -string ebede]
+    }
+    lappend array [list -string $last]
+    
+    return [xmlrpc_call $url validator1.moderateSizeArrayCheck -array $array]
+}
+
+proc validate1.nestedStructTest {
+    {url http://www.theashergroup.com/RPC2}
+    {moe 1}
+    {larry 2}
+    {curly 4}
+    {startyear 1999}
+    {endyear 2001}
+} {
+    
+    set calendar ""
+    # for each year
+    for {set y $startyear} {$y <= $endyear} {incr y} {
+
+        set year [list]
+        # for each month
+        for {set m 1} {$m <= 12} {incr m} {
+
+            set month [list]
+            # for each day
+            set mstr [format %02d $m]
+            for {set d 1} {$d <= 31} {incr d} {
+                set dstr [format %02d $d]
+                # exit test (to find end of month)
+                set date \
+                        [clock format \
+                          [clock scan "[expr $d - 1] day" \
+                            -base [clock scan "$y-${mstr}-01"]] \
+                          -format "%y:%m:%d"]
+                set date [split $date :]
+                set reald [lindex $date 2]
+                if {![string equal $reald $dstr]} {
+                    break
+                }
+                
+                if {($y == 2000) && ($m == 4) && ($d == 1)} {
+                    set dayta \
+                        [list -struct \
+                           [list moe [list -int $moe] \
+                                 curly [list -int $curly] \
+                                 larry [list -int $larry]]]
+                } else {
+                    set dayta \
+                        [list -struct \
+                           [list moe [list -int [expr 2 * $moe]]]]
+                }
+                set month [concat $month [list $dstr $dayta]]
+            }
+            set year [concat $year       [list $mstr [list -struct $month]]]
+        }
+        set calendar [concat $calendar   [list $y    [list -struct $year]]]
+    }
+    
+    return [xmlrpc_call $url validator1.nestedStructTest -struct $calendar]
+}
+
+proc validate1.simpleStructReturnTest {
+    {url http://www.theashergroup.com/RPC2}
+    {number 2}
+} {
+    return [xmlrpc_call $url validator1.simpleStructReturnTest -int $number]
+}
\ No newline at end of file