- Timestamp:
- Jan 30, 2015 8:40:51 AM (6 years ago)
- Location:
- branches/1.4
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/1.4
- Property svn:mergeinfo changed
/trunk merged: 4959,4961
- Property svn:mergeinfo changed
-
branches/1.4/gui/apps/launcher.tcl
r4863 r4963 27 27 set mainscript "" 28 28 set alist "" 29 set loadlist "" 29 30 set toolxml "" 31 32 # ---------------------------------------------------------------------- 33 # Look for parameters passed into the tool session. If there are 34 # any "file" parameters, they indicate files that should be loaded 35 # for browsing or executed to get results: 36 # 37 # file(load):/path/to/run.xml 38 # file(execute):/path/to/driver.xml 39 # ---------------------------------------------------------------------- 40 set params(opt) "" 41 set params(load) "" 42 set params(execute) "" 43 set params(input) "" 44 45 if {[info exists env(TOOL_PARAMETERS)]} { 46 # if we can't find the file, wait a little 47 set ntries 25 48 while {$ntries > 0 && ![file exists $env(TOOL_PARAMETERS)]} { 49 after 200 50 incr ntries -1 51 } 52 53 if {![file exists $env(TOOL_PARAMETERS)]} { 54 # still no file after all that? then skip parameters 55 puts stderr "WARNING: can't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\nFile not found." 56 57 } elseif {[catch { 58 # read the file and parse the contents 59 set fid [open $env(TOOL_PARAMETERS) r] 60 set info [read $fid] 61 close $fid 62 } result] != 0} { 63 puts stderr "WARNING: can't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\n$result" 64 65 } else { 66 # parse the contents of the tool parameter file 67 foreach line [split $info \n] { 68 set line [string trim $line] 69 if {$line eq "" || [regexp {^#} $line]} { 70 continue 71 } 72 73 if {[regexp {^([a-zA-Z]+)(\(into\:)(.+)\)\:(.+)$} $line match type name path value] 74 || [regexp {^([a-zA-Z]+)(\([^)]+\))?\:(.+)} $line match type name value]} { 75 if {$type eq "file"} { 76 switch -exact -- $name { 77 "(load)" - "" { 78 lappend params(load) $value 79 set params(opt) "-load" 80 } 81 "(execute)" { 82 set params(execute) $value 83 set params(opt) "-execute" 84 } 85 "(input)" { 86 set params(input) $value 87 set params(opt) "-input" 88 } 89 "(into:" { 90 namespace eval ::Rappture { # forward decl } 91 set ::Rappture::parameters($path) $value 92 } 93 default { 94 puts stderr "WARNING: directive $name not recognized for file parameter \"$value\"" 95 } 96 } 97 } 98 } 99 } 100 } 101 } 30 102 31 103 # scan through the arguments and look for the function … … 81 153 lappend alist -tool $toolxml 82 154 } 83 -t ool - -testdir - -nosim {155 -testdir - -nosim { 84 156 lappend alist $opt [lindex $argv 0] 85 157 set argv [lrange $argv 1 end] … … 93 165 } 94 166 -load { 95 lappend alist $opt96 167 while { [llength $argv] > 0 } { 97 168 set val [lindex $argv 0] … … 99 170 break 100 171 } 101 lappend alist $val172 lappend loadlist $val 102 173 set argv [lrange $argv 1 end] 103 174 } … … 115 186 } 116 187 117 # If no arguments, assume that it's the -run option 188 # If no arguments, check to see if there are any tool parameters. 189 # If not, then assume that it's the -run option. 118 190 if {$mainscript eq ""} { 119 package require RapptureGUI 120 set guidir $RapptureGUI::library 121 set mainscript [file join $guidir scripts main.tcl] 122 set reqpkgs Tk 191 switch -- $params(opt) { 192 -load { 193 # add tool parameters to the end of any files given on cmd line 194 set loadlist [concat $loadlist $params(load)] 195 set alist [concat $alist -load $loadlist] 196 197 package require RapptureGUI 198 set guidir $RapptureGUI::library 199 set mainscript [file join $guidir scripts main.tcl] 200 set reqpkgs Tk 201 } 202 -execute { 203 if {[llength $params(execute)] != 1} { 204 puts stderr "ERROR: wrong number of (execute) files in TOOL_PARAMETERS (should be only 1)" 205 exit 1 206 } 207 set driverxml [lindex $params(execute) 0] 208 if {![file readable $driverxml]} { 209 puts stderr "error: driver file \"$driverxml\" not found" 210 exit 1 211 } 212 set dir [file dirname [info script]] 213 set mainscript [file join $dir execute.tcl] 214 set reqpkgs "" 215 } 216 "" - "-input" { 217 package require RapptureGUI 218 set guidir $RapptureGUI::library 219 set mainscript [file join $guidir scripts main.tcl] 220 set reqpkgs Tk 221 222 # finalize the -input argument for "rappture -run" 223 if {$params(input) ne ""} { 224 if {![file readable $params(input)]} { 225 puts stderr "error: driver file \"$params(input)\" not found" 226 exit 1 227 } 228 set alist [concat $alist -input $params(input)] 229 } 230 231 # finalize any pending -load arguments for "rappture -run" 232 if {[llength $loadlist] > 0} { 233 set alist [concat $alist -load $loadlist] 234 } 235 } 236 default { 237 puts stderr "internal error: funny action \"$params(opt)\" inferred from TOOL_PARAMETERS" 238 exit 1 239 } 240 } 241 } else { 242 # finalize any pending -load arguments for "rappture -run" 243 if {[llength $loadlist] > 0} { 244 set alist [concat $alist -load $loadlist] 245 } 123 246 } 124 247 -
branches/1.4/gui/scripts/main.tcl
r3700 r4963 93 93 value -tool tool.xml 94 94 list -load "" 95 value -input "" 95 96 value -nosim 0 96 }97 98 proc ReadToolParameters { numTries } {99 incr numTries -1100 if { $numTries < 0 } {101 return102 }103 global env104 set paramsFile $env(TOOL_PARAMETERS)105 if { ![file readable $paramsFile] } {106 after 500 ReadToolParmeters $numTries107 return108 }109 catch {110 set f [open $paramsFile "r"]111 set contents [read $f]112 close $f113 set pattern {^file\((.*)\):(.*)$}114 foreach line [split $contents "\n"] {115 if { [regexp $pattern $line match path rest] } {116 set ::Rappture::parameters($path) $rest117 }118 }119 }120 }121 122 if { [info exists env(TOOL_PARAMETERS)] } {123 ReadToolParameters 10124 97 } 125 98 … … 132 105 set status [catch {Rappture::library $runfile} result] 133 106 lappend loadobjs $result 107 } 108 109 set inputobj {} 110 if {$params(-input) ne ""} { 111 if {![file exists $params(-input)]} { 112 puts stderr "can't find input file: \"$params(-input)\"" 113 exit 1 114 } 115 if {[catch {Rappture::library $params(-input)} result] == 0} { 116 set inputobj $result 117 } 134 118 } 135 119 … … 143 127 # run.xml files they are loading. 144 128 set pseudotool "" 145 if { 0 == [llength $loadobjs]} {129 if {[llength $loadobjs] == 0 && $inputobj eq ""} { 146 130 puts stderr "can't find tool \"$params(-tool)\"" 147 131 exit 1 … … 151 135 # if there are loaders or notes, they will still need 152 136 # examples/ and docs/ dirs from the install location 153 foreach runobj $loadobjs { 137 set check [concat $loadobjs $inputobj] 138 foreach runobj $check { 154 139 set tdir \ 155 140 [string trim [$runobj get tool.version.application.directory(tool)]] … … 374 359 375 360 # load previous xml runfiles 376 if { 0 != [llength $params(-load)]} {361 if {[llength $params(-load)] > 0} { 377 362 foreach runobj $loadobjs { 378 # this doesn't seem to work with loaders379 # loaders seem to get their value after this point380 # may need to tell loader elements to update its value381 $tool load $runobj382 363 $f.analyze load $runobj 383 364 } 365 # load the inputs for the very last run 366 $tool load $runobj 367 384 368 # don't need simulate button if we cannot simulate 385 369 if {$params(-nosim)} { … … 388 372 $f.analyze configure -notebookpage analyze 389 373 $win.pager current analyzer 374 } elseif {$params(-input) ne ""} { 375 $tool load $inputobj 376 } 377 378 # let components (loaders) settle after the newly loaded runs 379 update 380 381 foreach path [array names ::Rappture::parameters] { 382 set fname $::Rappture::parameters($path) 383 if {[catch { 384 set fid [open $fname r] 385 set info [read $fid] 386 close $fid}] == 0} { 387 388 set w [$tool widgetfor $path] 389 if {$w ne ""} { 390 if {[catch {$w value [string trim $info]} result]} { 391 puts stderr "WARNING: bad tool parameter value for \"$path\"" 392 puts stderr " $result" 393 } 394 } else { 395 puts stderr "WARNING: can't find control for tool parameter: $path" 396 } 397 } 390 398 } 391 399 -
branches/1.4/gui/scripts/textentry.tcl
r4405 r4963 106 106 # the string alone. 107 107 set str [string trim [$_owner xml get $path.default]] 108 if { [info exists ::Rappture::parameters($path.default)] } {109 set fileName $::Rappture::parameters($path.default)110 catch {111 set f [open $fileName "r"]112 set contents [read $f]113 close $f114 set str $contents115 }116 }117 108 if {"" != $str} { 118 109 value $str -
branches/1.4/lang/tcl/scripts/xauth.tcl
r4653 r4963 11 11 # set clientSecret [XAuth::credentials get nanoHUB.org -secret] 12 12 # 13 # XAuth::init $site $clientToken $clientSecret $username $password13 # XAuth::init $site $clientToken $clientSecret -user $username $password 14 14 # XAuth::call $site $method $params 15 15 # … … 20 20 # ====================================================================== 21 21 # AUTHOR: Michael McLennan, Purdue University 22 # Copyright (c) 2004-201 3HUBzero Foundation, LLC22 # Copyright (c) 2004-2015 HUBzero Foundation, LLC 23 23 # 24 24 # See the file "license.terms" for information on usage and … … 287 287 288 288 # ---------------------------------------------------------------------- 289 # USAGE: XAuth::init <site> <clientToken> <clientSecret> <username> <password> 290 # 291 # Should be called to initialize this library. Sends the <username> 292 # and <password> to the <site> for authentication. The <client> ID 293 # is registered with the OAuth provider to identify the application. 289 # USAGE: XAuth::init <site> <clientToken> <clientSecret> -user <u> <p> 290 # USAGE: XAuth::init <site> <clientToken> <clientSecret> -session <n> <t> 291 # 292 # Should be called to initialize this library. Can be initialized 293 # one of two ways: 294 # 295 # -user <u> <p> ...... sends username <u> and password <p> 296 # -session <n> <t> ... sends tool session number <n> and token <t> 297 # 298 # Sends the credentials to the <site> for authentication. The client 299 # token and secret are registered to identify the application. 294 300 # If successful, this call stores an authenticated session token in 295 301 # the tokens array for the <site> URL. Subsequent calls to XAuth::call 296 302 # use this token to identify the user. 297 303 # ---------------------------------------------------------------------- 298 proc XAuth::init {site clientToken clientSecret uname passw} {304 proc XAuth::init {site clientToken clientSecret args} { 299 305 variable clients 300 306 variable tokens 307 308 set option [lindex $args 0] 309 switch -- $option { 310 -user { 311 if {[llength $args] != 3} { 312 error "wrong # args: should be \"-user name password\"" 313 } 314 set uname [lindex $args 1] 315 set passw [lindex $args 2] 316 } 317 -session { 318 if {[llength $args] != 3} { 319 error "wrong # args: should be \"-session number token\"" 320 } 321 set snum [lindex $args 1] 322 set stok [lindex $args 2] 323 324 # store session info for later -- no need for oauth stuff 325 set tokens($site) [list session $snum $stok] 326 set clients($site) [list $clientToken $clientSecret] 327 return 328 } 329 default { 330 if {[llength $args] != 2} { 331 error "wrong # args: should be \"XAuth::init site token secret ?-option? arg arg\"" 332 } 333 set uname [lindex $args 0] 334 set passw [lindex $args 1] 335 } 336 } 301 337 302 338 if {![regexp {^https://} $site]} { … … 360 396 361 397 # success! store the session token for later 362 set tokens($site) [list $got(oauth_token) $got(oauth_token_secret)]398 set tokens($site) [list oauth $got(oauth_token) $got(oauth_token_secret)] 363 399 set clients($site) [list $clientToken $clientSecret] 364 400 } … … 385 421 } 386 422 foreach {clientToken clientSecret} $clients($site) break 387 foreach { userToken userSecret} $tokens($site) break423 foreach {scheme userToken userSecret} $tokens($site) break 388 424 389 425 set url $site/$method 390 set nonce [XAuth::nonce] 391 set tstamp [clock seconds] 392 393 # BE CAREFUL -- put all query parameters in alphabetical order 394 array set qparams [list \ 395 oauth_consumer_key $clientToken \ 396 oauth_nonce $nonce \ 397 oauth_signature_method "HMAC-SHA1" \ 398 oauth_timestamp $tstamp \ 399 oauth_token $userToken \ 400 oauth_version "1.0" \ 401 x_auth_mode "client_auth" \ 402 ] 403 array set qparams $params 404 405 set query "" 406 foreach key [lsort [array names qparams]] { 407 lappend query $key $qparams($key) 408 } 409 set query [eval http::formatQuery $query] 410 411 set base "POST&[urlencode $url]&[urlencode $query]" 412 set key "$clientSecret&$userSecret" 413 set sig [urlencode [base64::encode [sha1::hmac -bin -key $key $base]]] 414 415 # build the header and send the request 416 set auth [format "OAuth oauth_consumer_key=\"%s\", oauth_token=\"%s\", oauth_nonce=\"%s\", oauth_signature_method=\"HMAC-SHA1\", oauth_signature=\"%s\", oauth_timestamp=\"%s\", oauth_version=\"1.0\"" $clientToken $userToken $nonce $sig $tstamp] 417 418 return [XAuth::fetch $url -headers [list Authorization $auth] -query $query] 426 427 switch -- $scheme { 428 oauth { 429 set nonce [XAuth::nonce] 430 set tstamp [clock seconds] 431 432 # BE CAREFUL -- put all query parameters in alphabetical order 433 array set qparams [list \ 434 oauth_consumer_key $clientToken \ 435 oauth_nonce $nonce \ 436 oauth_signature_method "HMAC-SHA1" \ 437 oauth_timestamp $tstamp \ 438 oauth_token $userToken \ 439 oauth_version "1.0" \ 440 x_auth_mode "client_auth" \ 441 ] 442 array set qparams $params 443 444 set query "" 445 foreach key [lsort [array names qparams]] { 446 lappend query $key $qparams($key) 447 } 448 set query [eval http::formatQuery $query] 449 450 set base "POST&[urlencode $url]&[urlencode $query]" 451 set key "$clientSecret&$userSecret" 452 set sig [urlencode [base64::encode [sha1::hmac -bin -key $key $base]]] 453 454 # build the header and send the request 455 set auth [format "OAuth oauth_consumer_key=\"%s\", oauth_token=\"%s\", oauth_nonce=\"%s\", oauth_signature_method=\"HMAC-SHA1\", oauth_signature=\"%s\", oauth_timestamp=\"%s\", oauth_version=\"1.0\"" $clientToken $userToken $nonce $sig $tstamp] 456 set hdr [list Authorization $auth] 457 } 458 session { 459 set hdr [list sessionnum $userToken sessiontoken $userSecret] 460 set query "" 461 foreach {key val} $params { 462 lappend query $key $val 463 } 464 set query [eval http::formatQuery $query] 465 } 466 default { 467 error "internal error -- don't understand call scheme \"$scheme\"" 468 } 469 } 470 return [XAuth::fetch $url -headers $hdr -query $query] 419 471 } 420 472 … … 596 648 switch -- $option { 597 649 load { 598 set fname "~/.xauth"599 650 if {[llength $args] == 1} { 600 651 set fname [lindex $args 0] 601 } elseif {[llength $args] > 1} { 652 } elseif {[llength $args] == 0} { 653 if {[file exists ~/.xauth]} { 654 set fname "~/.xauth" 655 } else { 656 set fname "" 657 } 658 } else { 602 659 error "wrong # args: should be \"credentials load ?file?\"" 603 660 } 604 661 605 if {![file readable $fname]} { 606 error "file \"$fname\" not found" 607 } 608 set fid [open $fname r] 609 set info [read $fid] 610 close $fid 611 612 if {[catch {$parser eval $info} result]} { 613 error "error in sites file \"$fname\": $result" 662 if {$fname ne ""} { 663 if {![file readable $fname]} { 664 error "file \"$fname\" not found" 665 } 666 set fid [open $fname r] 667 set info [read $fid] 668 close $fid 669 670 if {[catch {$parser eval $info} result]} { 671 error "error in sites file \"$fname\": $result" 672 } 614 673 } 615 674 }
Note: See TracChangeset
for help on using the changeset viewer.