1# JSONRPC.tcl 2# Copyright (C) 2005 Ashok P. Nadkarnis <apnadkarni@users.sourceforge.net> 3# 4# Provide Tcl access to JSON-RPC methods. 5# Based on XMLRPC.tcl in the TclSOAP package, this package uses 6# much of the common communication transport code from the TclSOAP 7# package. 8 9# 10# ------------------------------------------------------------------------- 11# This software is distributed in the hope that it will be useful, but 12# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 13# or FITNESS FOR A PARTICULAR PURPOSE. See the accompanying file `LICENSE' 14# for more details. 15# ------------------------------------------------------------------------- 16 17package require SOAP::Utils 18package require SOAP 1.4 19package require rpcvar 20package require json 21 22namespace eval ::JSONRPC { 23 variable version 0.1.0; # Software version 24 variable rcs_version { $Id: jsonrpc.tcl,v 1.4 2008/10/09 11:02:30 apnadkarni Exp $ } 25 26 variable jsonrpc_state; # Array to hold global stuff 27 set jsonrpc_state(request_id) 0; # Used to identify requests 28 29 namespace export create cget dump configure proxyconfig export 30 # catch {namespace import -force [uplevel {namespace current}]::rpcvar::*} 31 # catch {namespace import -force ::SOAP::Utils::*} 32 33 # Create the typedefs for a jsonrequest and jsonresponse. 34 # Note: Some servers (for example the test server at 35 # http://jsolait.net/wiki/examples/jsonrpc/tester) seem to insist 36 # that the id field be a formatted as a string and not an integer 37 ::rpcvar::typedef { 38 jsonrpc string 39 id string 40 params array 41 method string 42 } jsonrequest 43 44 ::rpcvar::typedef { 45 jsonrpc string 46 id string 47 params object 48 method string 49 } jsonrequest_namedparams 50 51 ::rpcvar::typedef { 52 code int 53 message string 54 data any 55 } jsonerror 56 57 ::rpcvar::typedef { 58 jsonrpc string 59 id string 60 result any 61 error jsonerror 62 } jsonresponse 63 64} 65 66# ------------------------------------------------------------------------- 67 68# Delegate all these methods to the SOAP package. This does not mean 69# all the options for SOAP are supported or meaningful for JSON-RPC but 70# the irrelevant ones will be ignored. We do need to override the 71# SOAP method call wrapper and unwrapper functions. 72proc ::JSONRPC::create {args} { 73 set args [linsert $args 1 \ 74 -rpcprotocol JSONRPC \ 75 -contenttype "application/json-rpc" \ 76 -wrapProc [namespace origin \ 77 [namespace parent]::JSONRPC::request] \ 78 -parseProc [namespace origin \ 79 [namespace parent]::JSONRPC::parse_response]] 80 return [uplevel 1 "SOAP::create $args"] 81} 82 83proc ::JSONRPC::configure { args } { 84 return [uplevel 1 "SOAP::configure $args"] 85} 86 87proc ::JSONRPC::cget { args } { 88 return [uplevel 1 "SOAP::cget $args"] 89} 90 91proc ::JSONRPC::dump { args } { 92 return [uplevel 1 "SOAP::dump $args"] 93} 94 95proc ::JSONRPC::proxyconfig { args } { 96 return [uplevel 1 "SOAP::proxyconfig $args"] 97} 98 99proc ::JSONRPC::export {args} { 100 foreach item $args { 101 uplevel "set \[namespace current\]::__jsonrpc_exports($item)\ 102 \[namespace code $item\]" 103 } 104 return 105} 106 107# ------------------------------------------------------------------------- 108 109# Description: 110# Prepare an JSON-RPC fault (error) response 111# Parameters: 112# faultcode the JSON-RPC fault code (numeric) 113# faultstring summary of the fault 114# detail list of {detailName detailInfo} 115# Result: 116# Returns the JSON text of the error packet. 117# 118proc ::JSONRPC::fault {jsonver reqid faultcode faultstring {detail {}}} { 119 if {[llength $detail] == 0} { 120 set err [list code $faultcode message $faultstring] 121 } else { 122 set err [list \ 123 code $faultcode \ 124 message $faultstring \ 125 data [rpcvar::rpcvar struct $detail]] 126 } 127 return [jsonresponse $jsonver $reqid $err error] 128} 129 130proc ::JSONRPC::encode_value {value} { 131 set type [rpcvar::rpctype $value] 132 set value [rpcvar::rpcvalue $value] 133 set typeinfo [rpcvar::typedef -info $type] 134 135 if {[string match {*()} $type] || [string match array $type]} { 136 # Arrays have a type suffix of "()" 137 set itemtype [string trimright $type ()] 138 if {$itemtype == "array"} { 139 set itemtype "any" 140 } 141 set acc {} 142 foreach elt $value { 143 if {[string match $itemtype "any"]} { 144 lappend acc [JSONRPC::encode_value $elt] 145 } else { 146 lappend acc [JSONRPC::encode_value [rpcvar::rpcvar $itemtype $elt]] 147 } 148 } 149 return "\[[join $acc ,]\]" 150 } elseif {[llength $typeinfo] > 1} { 151 # a typedef'd struct (object in json) 152 array set ti $typeinfo 153 set acc {} 154 foreach {eltname eltvalue} $value { 155 156 if {![info exists ti($eltname)]} { 157 error "Invalid member name: \"$eltname\" is not a member of the $type object typedef." \ 158 "" [list JSONRPC local "Invalid object member name"] 159 } 160 if {$ti($eltname) eq "any"} { 161 lappend acc "\"$eltname\":[JSONRPC::encode_value $eltvalue]" 162 } else { 163 lappend acc "\"$eltname\":[JSONRPC::encode_value [rpcvar::rpcvar $ti($eltname) $eltvalue]]" 164 } 165 } 166 return "{[join $acc ,]}" 167 } elseif {[string equal struct $type] || [string equal object $type]} { 168 # an undefined struct (json object) 169 set acc {} 170 foreach {eltname eltvalue} $value { 171 lappend acc "\"$eltname\":[JSONRPC::encode_value $eltvalue]" 172 } 173 return "{[join $acc ,]}" 174 } elseif {[string equal $type "string"]} { 175 return "\"[JSONRPC::escape $value]\"" 176 } elseif {$type eq "number" || $type eq "int" || $type eq "float" || $type eq "double"} { 177 # Convert hex and octal to standard decimal. Also 178 # canonicalizes floating point 179 return [expr $value] 180 } elseif {[string match bool* $type]} { 181 return [expr {$value ? true : false}] 182 } else { 183 # All other simple types 184 return $value 185 } 186} 187 188# 189# Escapes a JSON string 190proc ::JSONRPC::escape {s} { 191 # Initialize the map for escaping special characters 192 193 # First do control characters as \u00xx sequences 194 for {set i 0} {$i < 32} {incr i} { 195 set map([format %c $i]) \\u[format %04x $i] 196 } 197 198 # Replace certain well known control characters with \ sequences 199 set map([format %c 8]) \\b; # backspace 200 set map([format %c 9]) \\t; # tab 201 set map([format %c 10]) \\n; # lf 202 set map([format %c 12]) \\f; # ff 203 set map([format %c 13]) \\r; # cr 204 205 # Other special sequences 206 set map(\") {\"} 207 set map(\\) {\\} 208 set map(/) {\/} 209 210 set [namespace current]::json_escape_map [array get map] 211 212 # Redefine ourselves so we do not initialize every time 213 proc ::JSONRPC::escape s { 214 variable json_escape_map 215 return [string map $json_escape_map $s] 216 } 217 218 # Call the redefined proc from the caller's level 219 return [uplevel 1 [info level 0]] 220} 221 222 223# 224# Description: 225# Procedure to generate the JSON data for a configured JSONRPC procedure. 226# Parameters: 227# procVarName - the name of the JSONRPC method variable 228# args - the arguments for this RPC method 229# Result: 230# Payload data containing the JSONRPC method call. 231# 232proc ::JSONRPC::request {procVarName args} { 233 variable jsonrpc_state 234 235 upvar $procVarName procvar 236 237 set procName [lindex [split $procVarName {_}] end] 238 set params $procvar(params) 239 set name $procvar(name) 240 241 if { [llength $args] != [expr { [llength $params] / 2 } ]} { 242 set msg "wrong # args: should be \"$procName" 243 foreach { id type } $params { 244 append msg " " $id 245 } 246 append msg "\"" 247 return -code error -errorcode [list JSONRPC local "Wrong number of arguments."] $msg 248 } 249 250 # Construct the typed parameter list. The parameter 251 # list is constructed as an array (by position) unless specified 252 # otherwise by that caller as an object (by name) 253 set plist [list ] 254 if { [llength $params] != 0 } { 255 if {$procvar(namedparams)} { 256 foreach {pname ptype} $params val $args { 257 lappend plist $pname [rpcvar::rpcvar $ptype $val] 258 } 259 } else { 260 foreach {pname ptype} $params val $args { 261 lappend plist [rpcvar::rpcvar $ptype $val] 262 } 263 } 264 } 265 266 # Sent as a JSON object 267 # { "jsonrpc" : VERSIONSTRING, "method" : METHODNAMESTRING, "params" : [ PARAMARRAYLIST ], "id" : ID } 268 # The params element may be left out if no params according to the spec but 269 # some servers object to this so always fill it in. 270 # The id element is filled in, but not currently used as the 271 # TclSOAP interface has no way to 272 # have the caller associated requests with responses 273 274 # Version 1 JSON has no version field 275 set reqflds [list id [incr jsonrpc_state(request_id)] method $name] 276 if {$procvar(version) ne "" && 277 ! [string match "1.*" $procvar(version)]} { 278 lappend reqflds jsonrpc $procvar(version) 279 } 280 281 lappend reqflds params $plist 282 283 if {$procvar(namedparams)} { 284 return [encode_value [rpcvar::rpcvar jsonrequest_namedparams $reqflds]] 285 } else { 286 return [encode_value [rpcvar::rpcvar jsonrequest $reqflds]] 287 } 288} 289 290 291# Description: 292# Parse an JSON-RPC response payload. Check for fault response otherwise 293# extract the value data. 294# Parameters: 295# procVarName - the name of the JSON-RPC method configuration variable 296# payload - the payload of the response 297# Result: 298# The extracted value(s). Array types are converted into lists and struct/object 299# types are turned into lists of name/value pairs suitable for array set 300# Notes: 301# The XML-RPC fault response doesn't allow us to add in extra values 302# to the fault struct. So where to put the servers errorInfo? 303# 304proc ::JSONRPC::parse_response { procVarName payload } { 305 upvar $procVarName procvar 306 307 set result {} 308 if {$payload == {} && ![string match "http*" $procvar(proxy)]} { 309 # This is probably not an error. SMTP and FTP won't return anything 310 # HTTP should always return though (I think). 311 return {} 312 } else { 313 if {[catch {set response [::json::json2dict $payload]}]} { 314 return -code error \ 315 -errorcode [list JSONRPC local \ 316 "Server response is not well-formed JSON. The response was '$payload'"] 317 } 318 } 319 320 # The response will have the following fields: 321 # jsonrpc - protocol version, may be missing for V1.0 servers 322 # (ignored) 323 # result - the result value - only if no errors 324 # error - error value on faults 325 # id - the id from the original request (currently ignored 326 327 # Both error and result fields should not be simultaneously present. 328 # But older servers may return various combinations. 329 # TBD - check handling of JSON null values 330 if {[dict exists $response error] && 331 [dict get $response error] ne "null"} { 332 set err [dict get $response error] 333 if {[dict exists $err message]} { 334 set ermsg "Error response from server: [dict get $err message]" 335 } else { 336 set ermsg "Server returned an error." 337 } 338 return -code error -errorcode [list JSONRPC remote [dict get $response error]] $ermsg 339 } 340 341 if {![dict exists $response result]} { 342 return -code error -errorcode [list JSONRPC local \ 343 "Server response is not well-formed JSON-RPC response. The response was '$payload'"] 344 } 345 346 return [dict get $response result] 347} 348 349 350# ------------------------------------------------------------------------- 351# Description: 352# Parse an JSON-RPC call payload. Extracts method name and parameters. 353# Parameters: 354# procVarName - the name of the JSON-RPC method configuration variable 355# payload - the payload of the response 356# Result: 357# A list containing the context of the request as the first element, 358# the name of the called method as second element, 359# and the extracted parameter(s) as third element. Array types are 360# converted into lists and struct types are turned into lists of 361# name/value pairs suitable for array set 362# Notes: 363# 364proc ::JSONRPC::parse_request { payload } { 365 set result {} 366 if {[catch {set request [::json::json2dict $payload]}]} { 367 return -code error -errorcode [list JSONRPC local "JSON request received with invalid format"] \ 368 "Client request is not well-formed JSON.\n\ 369 Call was '$payload'" 370 } 371 372 if {! ([dict exists $request method] && [dict exists $request id])} { 373 return -code error -errorinfo Server \ 374 "Client request is not well-formed JSON-RPC request.\n\ 375 Call was '$payload'" 376 } 377 378 set jsonrpcver "1.0" 379 if {[dict exists $request jsonrpc]} { 380 set jsonrpcver [dict get $request jsonrpc] 381 } 382 set id [dict get $request id] 383 set method [dict get $request method] 384 set params {} 385 if {[dict exists $request params]} { 386 set params [dict get $request params] 387 } 388 389 return [list [list $jsonrpcver $id] $method $params] 390} 391 392# ---------------------------------------------------------------- 393# Description: 394# Build a JSON-RPC response 395# Parameters: 396# jsonver - what version to use for formatting 397# reqid - the request id to which this is the response 398# value - result to be returned 399# type - "error" if error. Anything else is a result 400# Result: 401# A JSON formatted string 402proc ::JSONRPC::jsonresponse {jsonver reqid value {type result}} { 403 if {$type eq "error"} { 404 set respflds [list error $value id $reqid] 405 } else { 406 set respflds [list result $value id $reqid] 407 } 408 409 if {![string match "1.*" $jsonver]} { 410 lappend respflds jsonrpc $jsonver 411 } 412 413 return [::JSONRPC::encode_value [rpcvar::rpcvar jsonresponse $respflds]] 414} 415 416# Description: 417# Dummy JSONRPC transports to examine the JSONRPC requests generated for use 418# with the test package and for debugging. 419# Parameters: 420# procVarName - JSONRPC method name configuration variable 421# url - URL of the remote server method implementation 422# soap - the XML payload for this JSONRPC method call 423# 424namespace eval JSONRPC::Transport::print { 425 variable method:options {} 426 proc configure {args} { 427 return 428 } 429 proc xfer { procVarName url payload } { 430 puts url:$url 431 puts "$payload" 432 } 433 SOAP::register urn:print [namespace current] 434} 435 436namespace eval JSONRPC::Transport::reflect { 437 variable method:options { 438 contenttype 439 } 440 proc method:configure args { 441 return 442 } 443 proc configure {args} { 444 return 445 } 446 proc xfer {procVarName url payload} { 447 if {[catch { 448 foreach {jsoncontext method params} [::JSONRPC::parse_request $payload] break 449 foreach {jsonrpcver id} $jsoncontext break 450 if {$jsonrpcver eq ""} { 451 set jsonrpcver "1.0" 452 } 453 } msg]} { 454 # Could not even parse request - do not return error response 455 error msg $::errorInfo $::errorCode 456 } 457 458 # Request was parsed, not eval it if supported method 459 if {$method eq "calc"} { 460 if {[catch { 461 set result [eval expr $params] 462 } msg]} { 463 return [::JSONRPC::fault $jsonrpcver $id 1 $msg [list errorCode $::errorCode errorMessage $msg]] 464 } 465 } else { 466 return [::JSONRPC::fault $jsonrpcver $id -32601 "Method not found."] 467 } 468 469 return [::JSONRPC::jsonresponse $jsonrpcver $id [rpcvar::rpcvar string $result]] 470 } 471 SOAP::register urn:jsonreflect [namespace current] 472} 473 474# ------------------------------------------------------------------------- 475 476package provide JSONRPC $JSONRPC::version 477 478# ------------------------------------------------------------------------- 479 480# Local variables: 481# indent-tabs-mode: nil 482# End: 483