From 02431ee7cd26449641620fb0137b7c7eb062a1dc Mon Sep 17 00:00:00 2001 From: bcbrock Date: Thu, 22 Sep 2016 10:39:31 -0500 Subject: [PATCH] Busywork updates 9/22/2016 Several changes are required due to the removal of the /devops route from the REST API. The major change here is the conversion of the Tcl ::fabric package to use the /chaincode route instead of /devops. Several other enhancements and bug fixes are also inclued: 1) Fixes FAB-139 (Timer overflow) 2) Fixes FAB-414 (Additional timestamp for all TX committed) Tcl support for reading /proc//stat was added. This allows more statistics to be printed after the Busywork run (e.g., user + system time and CPU utilization). /proc//stat fields can also be accessed for the peers now by way of the 'busy' command, which was also enhanced with 'ps' and 'pid' subcommands. The 'pprofClient' was updated to support Go 1.7 naming conventions for pprof files. The -privacy flag was added to 'userModeNetwork'. Removed trailing whitespace from all modified files. Change-Id: Ie8d2cc95fb6e7384ce3fbb4d19949d14ec19ddc7 Signed-off-by: Bishop Brock --- tools/busywork/bin/busy | 109 ++++++++++++----- tools/busywork/bin/pprofClient | 89 ++++++++------ tools/busywork/bin/userModeNetwork | 8 ++ tools/busywork/counters/driver | 68 ++++++++++- tools/busywork/tcl/fabric.tcl | 188 +++++++++++++++-------------- tools/busywork/tcl/os.tcl | 102 +++++++++++++++- 6 files changed, 393 insertions(+), 171 deletions(-) diff --git a/tools/busywork/bin/busy b/tools/busywork/bin/busy index 242c639a6c1..c7d87091d09 100755 --- a/tools/busywork/bin/busy +++ b/tools/busywork/bin/busy @@ -1,13 +1,13 @@ #!/usr/bin/tclsh # Copyright IBM Corp. 2016. All Rights Reserved. -# +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at -# +# # http://www.apache.org/licenses/LICENSE-2.0 -# +# # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -19,18 +19,18 @@ set usage { The 'busy' script runs commands on one or more peers in a busywork network, printing the salient portion of the response on stdout. 'busy' can be seen as -an easier-to-use version of the Hyperledger fabric command-line-interface -(CLI) in that 'busy' takes care of various kinds of bookkeeping and -boilerplate code behind the scenes. 'busy' is probably best used as a tool for -small scipts, or for issuing a few interactive commands to a peer -network. Alhough complex test scripts could be implemented entirely as 'busy' -calls, the performance of a test implemented this way would likely suffer from -the process-creation overhead of each 'busy' invocation. +an easier-to-use, enhanced version of the Hyperledger fabric +command-line-interface (CLI) in that 'busy' takes care of various kinds of +bookkeeping and boilerplate code behind the scenes. 'busy' is probably best +used as a tool for small scipts, or for issuing a few interactive commands to +a peer network. Alhough complex test scripts could be implemented entirely as +'busy' calls, the performance of a test implemented this way would likely +suffer from the process-creation overhead of each 'busy' invocation. If the 'busy' command targets a single peer (see below) then the response from -that peer is printed. If multiple peers are targeted, then the results are -collected and printed as a JSON object, where each result is keyed by the peer -name, e.g., +or for that peer is printed. If multiple peers are targeted, then the results +are collected and printed as a JSON object, where each result is keyed by the +peer name, e.g., { "vp0" : , @@ -39,8 +39,8 @@ name, e.g., "vp" : response> } -Use -json to force results from operations on a single peer to print as a JSON -object. +Include the -json option to force results from operations on a single peer to +print as a JSON object. 'busy' is only supported for peer networks described by a 'network' file in the BUSYWORK_HOME directory. The to target are named by the peer IDs @@ -76,6 +76,9 @@ The following command and argument forms are supported: ping + pid + ps + The 'network' and 'chaincodes' commands simply print the current 'network' and 'chaincodes' files respectively from the implied $BUSYWORK_HOME. @@ -110,6 +113,17 @@ queries fail. If the ping query succeeds then the output of the ping queries is returned. This function currently assumes that the chaincode implments a 'ping' query function with no parameters. +The 'pid' command simply returns the PID of each of the . + +The 'ps' command is used to obtain 'ps' information from one or more +peers. For each peer implied by the specification, the result returned +is the result from executing 'ps' as follows, where is the PID of each +of the : + + ps -p -ww --noheader -o + +Note that leading/trailing whitespace is removed from the result. + Examples: busy chaincodes @@ -124,6 +138,9 @@ Examples: busy ping "*" cc2 + busy pid vp0 + busy ps vp0 etime,cputime + Optional arguments, with defaults after the colon: -h | -help | --help : N/A @@ -149,12 +166,12 @@ Optional arguments, with defaults after the colon: The -waitFor option is supported for the 'deploy', 'invoke' and 'ping' commands only. The semantics are explained below in the section headed - "Semantics of -waitFor" + "Semantics of -waitFor" -json : See below Select -json to force even single-peer operations to print as a JSON - object, rather than simply as a value. This opiton is ignored for the + object, rather than simply as a value. This option is ignored for the 'chaincodes' and 'network' commands. @@ -191,6 +208,14 @@ proc singletonCommand {cmd} { } +proc fixedArgs {cmd nArgs} { + + if {[llength [parms args]] != $nArgs} { + errorExit "The '$cmd' command expects $nArgs arguments." + } +} + + proc chaincodes {} { singletonCommand chaincodes @@ -294,7 +319,7 @@ proc invoke {} { "Deployed IDs are $a(ids)" } set name $a($ccId.name) - + if {![null [parms waitFor]]} { set heights \ [mapeach address [parms restAddresses] { @@ -322,7 +347,7 @@ proc invoke {} { } } - + proc query {} { waitForNotOK query @@ -344,7 +369,7 @@ proc query {} { errorExit } set name $a($ccId.name) - + parms results \ [mapeach address [parms restAddresses] { return [fabric::query $address [parms user] $name $function $args] @@ -369,7 +394,7 @@ proc ping {} { errorExit } set name $a($ccId.name) - + proc _ping {name} { set results {} foreach address [parms restAddresses] { @@ -395,7 +420,33 @@ proc ping {} { } } - + +proc pid {} { + + waitForNotOK pid + fixedArgs pid 0 + + parms results [mapeach peer [parms peers] { + return [parms network.peer.$peer.pid] + }] +} + + +proc ps {} { + + waitForNotOK ps + fixedArgs ps 1 + + parms results [mapeach peer [parms peers] { + set pid [parms network.peer.$peer.pid] + if {[catch {exec ps -p $pid -ww --noheader -o [parms args]} result]} { + errorExit "Exec of 'ps' failed : $result" + } + return [string trim $result]; # Remove leading/trailing whitespace + }] +} + + ############################################################################ # The script ############################################################################ @@ -410,11 +461,11 @@ setLoggingLevel {} warn set options { {enum {-h -help --help} parms(help) 0 p_help} {key -home parms(home) {}} - {bool -user parms(user) {} p_user} + {key -user parms(user) {} p_user} {key -waitFor parms(waitFor) {}} {bool -json parms(json) 0} } - + mapKeywordArgs $argv $options parms(other) if {$p_help} { @@ -430,7 +481,7 @@ parms command [first [parms other]] switch [parms command] { chaincodes {chaincodes} network {network} -} +} parms peers [busywork::peersFromSpec [second [parms other]]] parms args [restn [parms other] 2] @@ -459,6 +510,8 @@ switch [parms command] { invoke {invoke} query {query} ping {ping} + pid {pid} + ps {ps} default {errorExit "Unrecognized command: [parms command]"} } @@ -489,9 +542,3 @@ if {[parms json] || [expr {[llength [parms results]] > 1}]} { puts [first [parms results]] } - - - - - - diff --git a/tools/busywork/bin/pprofClient b/tools/busywork/bin/pprofClient index 888c06f6a23..0e8df692184 100755 --- a/tools/busywork/bin/pprofClient +++ b/tools/busywork/bin/pprofClient @@ -1,13 +1,13 @@ #!/usr/bin/tclsh # Copyright IBM Corp. 2016. All Rights Reserved. -# +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at -# +# # http://www.apache.org/licenses/LICENSE-2.0 -# +# # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -66,7 +66,7 @@ of the profile files - they are named by the host:port of the profiling port, and given sequence numbers to make them unique. When this script is run against busywork networks, the final act of the script is to create symbolic links that substitute the host:port portion of the file names with the peer -names (vp[0,...N]). +names (vp[0,...N]). Optional arguments, with defaults after the colon: @@ -140,7 +140,7 @@ set options { {key -peers parms(peers) {} p_peers} {key -port parms(port) 6060} } - + mapKeywordArgs $argv $options parms(other) if {$p_help} { @@ -153,12 +153,12 @@ if {[parms quiet]} { } else { setLoggingLevel {} note } - + parms home [busywork::home [parms home]] # Handle implicit vs. explict peers. With implicit peers we can give the files # recognizable names. With explicit peers we can only use the host:port as the -# names. +# names. if {$p_peers} { @@ -175,34 +175,34 @@ if {$p_peers} { parms profileAddresses [parms ids] } else { - + # Implicit peers - + if {[catch {busywork::networkToArray ::parms network.} msg]} { errorExit $msg } - + switch [llength [parms other]] { - + 1 { # All peers - + parms service [parms other] parms ids [parms network.peer.ids] parms profileAddresses [parms network.peer.profileAddresses] } 2 { # Subset of peers - + set spec [first [parms other]] parms service [second [parms other]] - + if {[catch {enumerate $spec} result]} { errorExit \ "Error parsing peer specification : $result" } set nPeers [llength [parms network.peer.ids]] - + parms ids \ [mapeach n $result { if {$n > $nPeers} { @@ -214,7 +214,7 @@ if {$p_peers} { [mapeach n $result { return [lindex [parms network.peer.profileAddresses] $n] }] - + } default { puts $usage @@ -283,7 +283,8 @@ if {[waitPIDs $pids]} { # find the profile files that the tool just created and link the names given # by the tool with names based on the peer IDs. The Go pprof tool does not # support providing names for the profile files - it names them based on their -# http addresses using the form 'pprof..'. +# http addresses using the form 'pprof.[.].'. The form with the [.] was introduced in Go 1.7. # The renaming-via-links being done here is not perfect in every case, and can # cause confusion (but NOT lost files) if profiles from multiple runs are @@ -297,31 +298,41 @@ if {!$p_peers} { set idMap($target) $id } foreach file [glob pprof.*] { - if {[regexp {^pprof.([^:]+:\d+)(.*)(\d\d\d)(.*)} \ + set executable "" + if {[regexp {^pprof\.([^:]+:\d+)\.(.*)(\d\d\d)(.*)} \ $file match host a b c]} { - if {[info exists idMap($host)]} { - if {$p_tag} { - set b [parms tag] - } - set reName pprof.$host$a$b$c - set newName pprof.$idMap($host)$a$b$c - if {![file exists $newName]} { + + # We can't disambiguate the . form from a + # generic with a regular expression. So we need to + # check to see if one of the hosts we're interested in is a + # terminal suffix of the 'host' pulled form the regex match. + + foreach target [parms profileAddresses] { + if {[string match *$target $host]} { if {$p_tag} { - if {[catch {exec mv $file $reName} why]} { - errorExit "Can't rename $file to $reName : $why" - } - if {[catch {exec ln -sf $reName $newName} code]} { - errorExit \ - "Error linking $file to $newName : $code" - } - note {} "$newName -> $reName (from $file)" - } else { - if {[catch {exec ln -sf $file $newName} code]} { - errorExit \ - "Error linking $file to $newName : $code" + set b [parms tag] + } + set reName pprof.$host.$a$b$c + set newName pprof.$idMap($target).$a$b$c + if {![file exists $newName]} { + if {$p_tag} { + if {[catch {exec mv $file $reName} why]} { + errorExit "Can't rename $file to $reName : $why" + } + if {[catch {exec ln -sf $reName $newName} code]} { + errorExit \ + "Error linking $file to $newName : $code" + } + note {} "$newName -> $reName (from $file)" + } else { + if {[catch {exec ln -sf $file $newName} code]} { + errorExit \ + "Error linking $file to $newName : $code" + } + note {} "$newName -> $file" } - note {} "$newName -> $file" - } + } + break } } } diff --git a/tools/busywork/bin/userModeNetwork b/tools/busywork/bin/userModeNetwork index bdeab1ce601..9bdfc8e0a03 100755 --- a/tools/busywork/bin/userModeNetwork +++ b/tools/busywork/bin/userModeNetwork @@ -65,6 +65,11 @@ Optional arguments, with defaults after the colon: the 'membersrvc' server. Peer login credentials are obtained from the fabric/membersrvc.yaml file. +-privacy | -noPrivacy : -noPrivacy + + Controls whether privacy is enabled. This option only has effect if + -security is enabled. + -noops | -batch : -batch Use one of these options to select the consensus mode. The default @@ -194,6 +199,7 @@ set options { {key -home parms(home) {}} {key -interface parms(interface) {} p_interface} {bool {-security -noSecurity} parms(security) 0} + {bool {-privacy -noPrivacy} parms(privacy) 0} {enum {-noops -batch} parms(consensus) -batch} {bool {-profile -noProfile} parms(profile) 1} {enum {-pristine -clean -dirty} parms(clean) -pristine} @@ -360,6 +366,7 @@ puts $config " \"host\": \"local\"," puts $config " \"date\": \"[timestamp]\"," puts $config " \"createdBy\": \"userModeNetwork\"," puts $config " \"security\": \"[? [parms security] true false]\"," +puts $config " \"privacy\": \"[? [parms privacy] true false]\"," puts $config " \"consensus\": \"$CONSENSUS_TO_MODE([parms consensus])\"," puts $config " \"peerProfileServer\": \"[? [parms profile] true false]\"," @@ -454,6 +461,7 @@ foreach clause $peerMap { set ::env(CORE_SECURITY_ENROLLID) $user set ::env(CORE_SECURITY_ENROLLSECRET) $password set ::env(CORE_SECURITY_ENABLED) true + set ::env(CORE_SECURITY_PRIVACY) [? [parms privacy] true false] } else { set ::env(CORE_SECURITY_ENABLED) false } diff --git a/tools/busywork/counters/driver b/tools/busywork/counters/driver index 23af5a0cb0f..7015cbc7991 100755 --- a/tools/busywork/counters/driver +++ b/tools/busywork/counters/driver @@ -513,6 +513,20 @@ parms txDelay [durationToMs [parms txDelay]] parms peerDelay [durationToMs [parms peerDelay]] parms netDelay [durationToMs [parms netDelay]] +# We can collect run-time statistics if 1) We are running locally on Linux, +# and 2) if the driver was started from a busywork 'network' file. + +if {[parms remote] || + ![null [parms explicitPeers]] || + [catch {exec uname} os] || + ($os ne "Linux")} { + errorExit "'[parms remote]' '[null [parms explicitPeers]]' '$os'" + parms collectStats 0 +} else { + parms collectStats 1 +} + + ############################################################################ # Setup ############################################################################ @@ -904,6 +918,15 @@ proc clientRoutine {i_logger} { } +# Get peer stats before the client fork + +if {[parms collectStats]} { + foreach peer [parms network.peer.ids] pid [parms network.peer.pids] { + procPIDStat $pid ::parms stat.before.$peer. + } +} + + # Fork clients. The parent continues the script once all clients have exited; # clients run their driver routine and exit. @@ -946,14 +969,15 @@ if {$p_pprofClient} { # event of errors until the final agreement check. note {} "Waiting (indefinitely) for subprocesses to complete" -set t [time {set errors [waitPIDs $pids]} 1] +set startMs [clock milliseconds] +set errors [waitPIDs $pids] +set issueSec [expr ([clock milliseconds] - $startMs) / 1000.0] if {!$errors} { - set seconds [expr {[lindex $t 0] / 1e6}] - set rate [format %.2f [expr {[parms totalTransactions] / $seconds}]] + set rate [format %.2f [expr {[parms totalTransactions] / $issueSec}]] note {} \ - "Transaction rate : $rate per second " \ - "([parms totalTransactions] / $seconds)" + "Issue + interlock TX rate : $rate per second " \ + "([parms totalTransactions] / $issueSec)" } if {$p_pprofClient} { @@ -964,6 +988,33 @@ if {$p_pprofClient} { } } +# Print peer stats + +if {[parms collectStats]} { + if {[catch {exec getconf CLK_TCK} CLK_TCK]} { + error {} "Can't getconf CLK_TCK: $CLK_TCK" + } else { + set CLK_TCK $CLK_TCK.0; # Poor man's float() + note {} "Peer statistics (excluding initialization and deployment)" + note {} " Peer: CPU (sec) = User + System: Utilization: Threads" + note {} " -----------------------------------------------------" + foreach peer [parms network.peer.ids] pid [parms network.peer.pids] { + procPIDStat $pid ::parms stat.after.$peer. + set user \ + [expr {([parms stat.after.$peer.utime] - \ + [parms stat.before.$peer.utime]) / $CLK_TCK}] + set sys \ + [expr {([parms stat.after.$peer.stime] - \ + [parms stat.before.$peer.stime]) / $CLK_TCK}] + set cpu [expr {$user + $sys}] + set util [expr {$cpu * 100.0 / $issueSec}] + set threads [parms stat.after.$peer.num_threads] + note {} [format "%8s %8.2f %8.2f %8.2f %8.0f%% %10d" \ + $peer $cpu $user $sys $util $threads] + } + } +} + if {$errors && ![parms force]} { errorExit "Aborting due to client errors" } @@ -987,6 +1038,13 @@ if {[parms interlock] && ![parms noops]} { set heights [removeDuplicates $originalHeights] if {[llength $heights] != 1} { note {} " Observed block heights: $originalHeights" + } else { + note {} " Consensus block height: $heights" + set finalSec [expr ([clock milliseconds] - $::startMs) / 1000.0] + set rate [format %.2f [expr {[parms totalTransactions] / $finalSec}]] + note {} \ + "Fully committed TX rate : $rate per second " \ + "([parms totalTransactions] / $finalSec)" } return [expr {[llength $heights] == 1}] } diff --git a/tools/busywork/tcl/fabric.tcl b/tools/busywork/tcl/fabric.tcl index afe11a8dd6d..3a9b1e168fa 100644 --- a/tools/busywork/tcl/fabric.tcl +++ b/tools/busywork/tcl/fabric.tcl @@ -25,7 +25,7 @@ package provide fabric 0.0 namespace eval ::fabric {} ############################################################################ -# devops i_peer i_method i_query {i_retry 0} +# chaincode i_peer i_method i_query {i_retry 0} # Make a REST API 'devops' query. The i_peer is the full host:port # address. The i_method must be 'deploy', 'invoke' or 'query'. @@ -40,12 +40,12 @@ namespace eval ::fabric {} # exits. If the HTTP access fails then the call will exit with Tcl error{} and # the caller will presumably catch{} the error and do whatever is appropriate. -proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { +proc ::fabric::chaincode {i_peer i_method i_query {i_retry 0}} { for {set retry [math:::max $i_retry 0]} {$retry >= 0} {incr retry -1} { if {[catch { - ::http::geturl http://$i_peer/devops/$i_method -query $i_query + ::http::geturl http://$i_peer/chaincode -query $i_query } token]} { if {$i_retry < 0} { http::cleanup $token @@ -54,7 +54,7 @@ proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { if {$retry > 0} { if {$retry == $i_retry} { warn fabric \ - "fabric::devops/$i_method $i_peer : " \ + "fabric::chaincode $i_peer $i_method: " \ "Retrying after catastrophic HTTP error" } http::cleanup $token @@ -62,13 +62,13 @@ proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { } if {($retry == 0) && ($i_retry != 0)} { err fabric \ - "fabric::devops/$i_method $i_peer : " \ + "fabric::chaincode $i_peer $i_method: " \ "Retry limit ($i_retry) hit after " \ "catastrophic HTTP error : Aborting" } http::cleanup $token errorExit \ - "fabric::devops/$i_method $i_peer : ::http::geturl failed\n" \ + "fabric::chaincode $i_peer $i_method: ::http::geturl failed\n" \ $::errorInfo } @@ -80,12 +80,12 @@ proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { if {$retry > 0} { if {$retry == $i_retry} { warn fabric \ - "fabric::devops/$i_method $i_peer : " \ + "fabric::chaincode $i_peer $i_method: " \ "Retrying after HTTP error return" } if {($retry == 0) && ($i_retry != 0)} { err fabric \ - "fabric::devops/$i_method $i_peer : " \ + "fabric::chaincode $i_peer $i_method: " \ "Retry limit ($i_retry) hit after " \ "HTTP error return : Aborting" } @@ -93,48 +93,52 @@ proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { continue } err fabric \ - "FABRIC '$i_method' transaction to $i_peer failed " \ + "fabric::chaincode '$i_method' transaction to $i_peer failed " \ "with ncode = '[http::ncode $token]'; Aborting\n" httpErrorExit $token } set response [http::data $token] - set err [catch { + set fail [catch { set parse [json::json2dict $response] - set ok [dict get $parse OK] - switch $i_method { - deploy - - invoke { - set result [dict get $parse message] + set result [dict get $parse result] + set status [dict get $result status] + if {$status ne "OK"} { + error "Status not OK" } - query { - set result $ok - } - default { - error "Unrecognized method $i_method" - } - } - }] + set message [dict get $result message] + } err] - if {$err} { - err fabric \ - "FABRIC '$i_method' response from $i_peer " \ - "is malformed/unexpected" - httpErrorExit $token + if {$fail} { + + set msg \ + [concat \ + "fabric::chaincode '$i_method' response from $i_peer " \ + "is malformed/unexpected: $err"] + + if {$i_retry < 0} { + http::cleanup $token + error $msg + + } else { + + err fabric $msg + httpErrorExit $token + } } http::cleanup $token if {($i_retry >= 0) && ($retry != $i_retry)} { note fabric \ - "fabric::devops/$i_method $i_peer : " \ + "fabric::chaincode $i_peer $i_method: " \ "Success after [expr {$i_retry - $retry}] HTTP retries" } break } - return $result + return $message } @@ -144,17 +148,17 @@ proc ::fabric::devops {i_peer i_method i_query {i_retry 0}} { # Deploy a GOLANG chaincode to the network. The i_peer is the full network # address (host:port) of the REST API port of the peer. If i_user is # non-empty then this will be a secure transaction. The constructor will apply -# i_fn to i_args. Note that i_args is a normal Tcl list. This routine will -# convert i_args into a JSON array, wrapping each element of i_args in double -# quotes. i_fn will also be properly quoted. +# i_fn to i_args. -# See ::fabric::devops{} for a discussion of the 'i_retry' parameter. +# See ::fabric::chaincode{} for a discussion of the 'i_retry' parameter. proc ::fabric::deploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} { set template { - { - "type" : "GOLANG", + "jsonrpc" : "2.0", + "method" : "deploy", + "params" : { + "type": 1, "chaincodeID" : { "path" : "$i_chaincode" }, @@ -162,16 +166,17 @@ proc ::fabric::deploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} { "args" : [$args] }, "secureContext": "$i_user" - } + }, + "id": 1 } set args [argify $i_fn $i_args] - set query [subst -nocommand $template] - - return [devops $i_peer deploy $query $i_retry] + set query [list [subst -nocommand $template]] + return [chaincode $i_peer deploy $query $i_retry] } + ############################################################################ # devModeDeploy i_peer i_user i_chaincode i_fn i_args {i_retry 0} @@ -179,13 +184,15 @@ proc ::fabric::deploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} { # mode. Here, the i_chaincode is a user-specified name. All of the other # arguments are otherwise the same as for deploy{}. -# See ::fabric::devops{} for a discussion of the 'i_retry' parameter. +# See ::fabric::chaincode{} for a discussion of the 'i_retry' parameter. proc ::fabric::devModeDeploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} { set template { - { - "type" : "GOLANG", + "jsonrpc" : "2.0", + "method" : "deploy", + "params" : { + "type": 1, "chaincodeID" : { "name" : "$i_chaincode" }, @@ -193,14 +200,14 @@ proc ::fabric::devModeDeploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} "args" : [$args] }, "secureContext": "$i_user" - } + }, + "id": 1 } set args [argify $i_fn $i_args] - set query [subst -nocommand $template] + set query [list [subst -nocommand $template]] return [devops $i_peer deploy $query $i_retry] - } ############################################################################ @@ -209,33 +216,32 @@ proc ::fabric::devModeDeploy {i_peer i_user i_chaincode i_fn i_args {i_retry 0}} # Invoke a GOLANG chaincode on the network. The i_peer is the full network # address (host:port) of the REST API port of the peer. If i_user is non-empty # then this will be a secure transaction. The i_chaincodeName is the hash used -# to identify the chaincode. The invocation will apply i_fn to i_args. Note -# that i_args is a normal Tcl list. This routine will convert i_args into a -# JSON array, wrapping each element of i_args in double quotes. i_fn will also -# be properly quoted. +# to identify the chaincode. The invocation will apply i_fn to i_args. -# See ::fabric::devops{} for a discussion of the 'i_retry' parameter. +# See ::fabric::chaincode{} for a discussion of the 'i_retry' parameter. proc ::fabric::invoke {i_peer i_user i_chaincodeName i_fn i_args {i_retry 0}} { set template { - { - "chaincodeSpec" : {"type" : "GOLANG", - "chaincodeID" : { - "name" : "$i_chaincodeName" - }, - "ctorMsg" : { - "args" : [$args] - }, - "secureContext": "$i_user" - } - } + "jsonrpc" : "2.0", + "method" : "invoke", + "params" : { + "type": 1, + "chaincodeID" : { + "name" : "$i_chaincodeName" + }, + "ctorMsg" : { + "args" : [$args] + }, + "secureContext": "$i_user" + }, + "id": 1 } set args [argify $i_fn $i_args] - set query [subst -nocommand $template] + set query [list [subst -nocommand $template]] - return [devops $i_peer invoke $query $i_retry] + return [chaincode $i_peer invoke $query $i_retry] } @@ -245,34 +251,32 @@ proc ::fabric::invoke {i_peer i_user i_chaincodeName i_fn i_args {i_retry 0}} { # Query a GOLANG chaincode on the network. The i_peer is the full network # address (host:port) of the REST API port of the peer. If i_user is non-empty # then this will be a secure transaction. The i_chaincodeName is the hash used -# to identify the chaincode. The query will apply i_fn to i_args. Note that -# i_args is a normal Tcl list. This routine will convert i_args into a JSON -# array, wrapping each element of i_args in double quotes. i_fn will also be -# properly quoted. The query result (currently assumed to be a string) is -# returned. +# to identify the chaincode. The query will apply i_fn to i_args. -# See ::fabric::devops{} for a discussion of the 'i_retry' parameter. +# See ::fabric::chaincode{} for a discussion of the 'i_retry' parameter. proc ::fabric::query {i_peer i_user i_chaincodeName i_fn i_args {i_retry 0}} { set template { - { - "chaincodeSpec" : {"type" : "GOLANG", - "chaincodeID" : { - "name" : "$i_chaincodeName" - }, - "ctorMsg" : { - "args" : [$args] - }, - "secureContext": "$i_user" - } - } + "jsonrpc" : "2.0", + "method" : "query", + "params" : { + "type": 1, + "chaincodeID" : { + "name" : "$i_chaincodeName" + }, + "ctorMsg" : { + "args" : [$args] + }, + "secureContext": "$i_user" + }, + "id": 1 } set args [argify $i_fn $i_args] - set query [subst -nocommand $template] + set query [list [subst -nocommand $template]] - return [devops $i_peer query $query $i_retry] + return [chaincode $i_peer query $query $i_retry] } @@ -298,11 +302,11 @@ proc ::fabric::height {i_peer {i_retry 0}} { "$i_peer /chain: ::http::geturl failed " \ "with $i_retry retries : $token" } - + if {[http::ncode $token] != 200} { - + # Failure - + if {$retry > 0} { if {$retry == $i_retry} { warn fabric \ @@ -311,12 +315,12 @@ proc ::fabric::height {i_peer {i_retry 0}} { http::cleanup $token continue } - + err fabric \ "$i_peer /chain; REST API call failed with $i_retry retries" httpErrorExit $token } - + if {[catch {json::json2dict [http::data $token]} parse]} { err fabric "$i_peer /chain: JSON response does not parse: $parse" httpErrorExit $token @@ -430,7 +434,7 @@ proc ::fabric::caLogin {i_peer i_user i_secret} { ############################################################################ # argify i_fn i_args -# Convert old-style fn + args pair into a list of quoted base64 arguments with +# Convert old-style fn + args pair into a list of quoted arguments with # commas to satisfy the most recent JSON format of the REST API. This needs to # be done as a string (rather than as a list), otherwise it will be {} quoted # when substituted. @@ -438,11 +442,11 @@ proc ::fabric::caLogin {i_peer i_user i_secret} { proc ::fabric::argify {i_fn i_args} { set args [concat $i_fn $i_args] - set args64 "" + set jsonargs "" set comma "" foreach arg $args { - set args64 "$args64$comma\"[binary encode base64 $arg]\"" + set jsonargs "$jsonargs$comma\"$arg\"" set comma , } - return $args64 + return $jsonargs } diff --git a/tools/busywork/tcl/os.tcl b/tools/busywork/tcl/os.tcl index 32891b64ed9..b2c8af544b1 100644 --- a/tools/busywork/tcl/os.tcl +++ b/tools/busywork/tcl/os.tcl @@ -1,13 +1,13 @@ # os.tcl - Utilities related to the operating system functions # Copyright IBM Corp. 2016. All Rights Reserved. -# +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at -# +# # http://www.apache.org/licenses/LICENSE-2.0 -# +# # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -43,7 +43,7 @@ proc waitPIDs {pids {digest {}}} { set _digest($pid.why) $why set _digest($pid.rc) $rc set _digest($pid.ok) [expr {($why eq "EXIT") && ($rc == 0)}] - + switch $why { EXIT { if {$rc != 0} { @@ -67,3 +67,97 @@ proc waitPIDs {pids {digest {}}} { } return $rv } + + +############################################################################ +# procPIDStat i_pid o_array {i_prefix ""} + +# This procedure parses the result of executing + +# cat /proc/[i_pid]/stat + +# and stores the results in the array o_array keyed by name. See man proc(5) +# under /proc/[pid]/stat for an interpretation of the fields. The names are +# taken directly from the man page. The optional i_prefix can be specified to +# allow stats for multiple PIDs to be stored in the same array, using an +# indexing scheme chosen by the caller. + +# NB: This procedure only works on Linux, and will fail on other operating +# systems. + +# BUGS: Field 2 (comm) is the command name in parenthesis. If the file name of +# the command includes white space this will throw off the current parser. + +# Note: Copy/edited taken directly from the man page, which uses 1-based +# addressing. +array unset ::procPIDStatMap +foreach {index key} { + 1 pid + 2 comm + 3 state + 4 ppid + 5 pgrp + 6 session + 7 tty_nr + 8 tpgid + 9 flags + 10 minflt + 11 cminflt + 12 majflt + 13 cmajflt + 14 utime + 15 stime + 16 cutime + 17 cstime + 18 priority + 19 nice + 20 num_threads + 21 itrealvalue + 22 starttime + 23 vsize + 24 rss + 25 rsslim + 26 startcode + 27 endcode + 28 startstack + 29 kstkesp + 30 kstkeip + 31 signal + 32 blocked + 33 sigignore + 34 sigcatch + 35 wchan + 36 nswap + 37 cnswap + 38 exit_signal + 39 processor + 40 rt_priority + 41 policy + 42 delayacct_blkio_ticks + 43 guest_time + 44 cguest_time + 45 start_data + 46 end_data + 47 start_brk + 48 arg_start + 49 arg_end + 50 env_start + 51 env_end + 52 exit_code +} { + set ::procPIDStatMap([expr {$index - 1}]) $key +} + + +proc procPIDStat {i_pid o_array {i_prefix ""}} { + + upvar $o_array a + + if {[catch {exec cat /proc/$i_pid/stat} stat]} { + errorExit "Can not cat /proc/$i_pid/stat: $stat" + } + + foreach index [array names ::procPIDStatMap] { + set a($i_prefix$::procPIDStatMap($index)) [lindex $stat $index] + } +}