Changeset 4963 for branches


Ignore:
Timestamp:
Jan 30, 2015 8:40:51 AM (6 years ago)
Author:
ldelgass
Message:

Merge r4959,r4961 from trunk

Location:
branches/1.4
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/1.4

  • branches/1.4/gui/apps/launcher.tcl

    r4863 r4963  
    2727set mainscript ""
    2828set alist ""
     29set loadlist ""
    2930set 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# ----------------------------------------------------------------------
     40set params(opt) ""
     41set params(load) ""
     42set params(execute) ""
     43set params(input) ""
     44
     45if {[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}
    30102
    31103# scan through the arguments and look for the function
     
    81153                lappend alist -tool $toolxml
    82154            }
    83             -tool - -testdir - -nosim {
     155            -testdir - -nosim {
    84156                lappend alist $opt [lindex $argv 0]
    85157                set argv [lrange $argv 1 end]
     
    93165            }
    94166            -load {
    95                 lappend alist $opt
    96167                while { [llength $argv] > 0 } {
    97168                    set val [lindex $argv 0]
     
    99170                        break
    100171                    }
    101                     lappend alist $val
     172                    lappend loadlist $val
    102173                    set argv [lrange $argv 1 end]
    103174                }
     
    115186}
    116187
    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.
    118190if {$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    }
    123246}
    124247
  • branches/1.4/gui/scripts/main.tcl

    r3700 r4963  
    9393    value -tool tool.xml
    9494    list  -load ""
     95    value -input ""
    9596    value -nosim 0
    96 }
    97 
    98 proc ReadToolParameters { numTries } {
    99     incr numTries -1
    100     if { $numTries < 0 } {
    101         return
    102     }
    103     global env
    104     set paramsFile $env(TOOL_PARAMETERS)
    105     if { ![file readable $paramsFile] } {
    106         after 500 ReadToolParmeters $numTries
    107         return
    108     }
    109     catch {
    110         set f [open $paramsFile "r"]
    111         set contents [read $f]
    112         close $f
    113         set pattern {^file\((.*)\):(.*)$}
    114         foreach line [split $contents "\n"] {
    115             if { [regexp $pattern $line match path rest] } {
    116                 set ::Rappture::parameters($path) $rest
    117             }
    118         }
    119     }
    120 }
    121 
    122 if { [info exists env(TOOL_PARAMETERS)] } {
    123     ReadToolParameters 10
    12497}
    12598
     
    132105    set status [catch {Rappture::library $runfile} result]
    133106    lappend loadobjs $result
     107}
     108
     109set inputobj {}
     110if {$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    }
    134118}
    135119
     
    143127    # run.xml files they are loading.
    144128    set pseudotool ""
    145     if {0 == [llength $loadobjs]} {
     129    if {[llength $loadobjs] == 0 && $inputobj eq ""} {
    146130        puts stderr "can't find tool \"$params(-tool)\""
    147131        exit 1
     
    151135    # if there are loaders or notes, they will still need
    152136    # examples/ and docs/ dirs from the install location
    153     foreach runobj $loadobjs {
     137    set check [concat $loadobjs $inputobj]
     138    foreach runobj $check {
    154139        set tdir \
    155140            [string trim [$runobj get tool.version.application.directory(tool)]]
     
    374359
    375360# load previous xml runfiles
    376 if {0 != [llength $params(-load)]} {
     361if {[llength $params(-load)] > 0} {
    377362    foreach runobj $loadobjs {
    378         # this doesn't seem to work with loaders
    379         # loaders seem to get their value after this point
    380         # may need to tell loader elements to update its value
    381         $tool load $runobj
    382363        $f.analyze load $runobj
    383364    }
     365    # load the inputs for the very last run
     366    $tool load $runobj
     367
    384368    # don't need simulate button if we cannot simulate
    385369    if {$params(-nosim)} {
     
    388372    $f.analyze configure -notebookpage analyze
    389373    $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
     379update
     380
     381foreach 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    }
    390398}
    391399
  • branches/1.4/gui/scripts/textentry.tcl

    r4405 r4963  
    106106    # the string alone.
    107107    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 $f
    114             set str $contents
    115         }
    116     }
    117108    if {"" != $str} {
    118109        value $str
  • branches/1.4/lang/tcl/scripts/xauth.tcl

    r4653 r4963  
    1111#    set clientSecret [XAuth::credentials get nanoHUB.org -secret]
    1212#
    13 #    XAuth::init $site $clientToken $clientSecret $username $password
     13#    XAuth::init $site $clientToken $clientSecret -user $username $password
    1414#    XAuth::call $site $method $params
    1515#
     
    2020# ======================================================================
    2121#  AUTHOR:  Michael McLennan, Purdue University
    22 #  Copyright (c) 2004-2013  HUBzero Foundation, LLC
     22#  Copyright (c) 2004-2015  HUBzero Foundation, LLC
    2323#
    2424#  See the file "license.terms" for information on usage and
     
    287287
    288288# ----------------------------------------------------------------------
    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.
    294300# If successful, this call stores an authenticated session token in
    295301# the tokens array for the <site> URL.  Subsequent calls to XAuth::call
    296302# use this token to identify the user.
    297303# ----------------------------------------------------------------------
    298 proc XAuth::init {site clientToken clientSecret uname passw} {
     304proc XAuth::init {site clientToken clientSecret args} {
    299305    variable clients
    300306    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    }
    301337
    302338    if {![regexp {^https://} $site]} {
     
    360396
    361397    # 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)]
    363399    set clients($site) [list $clientToken $clientSecret]
    364400}
     
    385421    }
    386422    foreach {clientToken clientSecret} $clients($site) break
    387     foreach {userToken userSecret} $tokens($site) break
     423    foreach {scheme userToken userSecret} $tokens($site) break
    388424
    389425    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]
    419471}
    420472
     
    596648    switch -- $option {
    597649        load {
    598             set fname "~/.xauth"
    599650            if {[llength $args] == 1} {
    600651                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 {
    602659                error "wrong # args: should be \"credentials load ?file?\""
    603660            }
    604661
    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                }
    614673            }
    615674        }
Note: See TracChangeset for help on using the changeset viewer.