#!/bin/sh
#
# @package      hubzero-invokeapp
# @file         toolparams
# @copyright    Copyright (c) 2013-2020 The Regents of the University of California.
# @license      http://opensource.org/licenses/MIT MIT
#
# Copyright (c) 2013-2020 The Regents of the University of California.
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.
#
# HUBzero is a registered trademark of The Regents of the University of California.
#
# ----------------------------------------------------------------------
#  TOOLPARAMS
#
#  Used to execute a tool within a HUBzero container, taking parameters
#  passed in via the URL.  These parameters are stored in a file.  The
#  name of that file is passed in via the TOOL_PARAMETERS environment
#  variable.
#
#    USAGE:
#    % toolparams templ ?-or templ ...? ?-default command?
#
#  where "templ" is a template string used to invoke the command.
#  For example:
#
#    toolparams 'firefox @@file(#1)'
#    toolparams 'firefox @@file(url)' -default firefox
#
#  Each target '@@file(name)' gets substituted with a parameter that
#  might have been passed into the tool invocation.  The '@@file' part
#  means that we're expecting a file name.  The ()'s contain the name
#  of the desired argument or its position (e.g., #2) on the invocation
#  line.
#
#  This command takes at least one template and tries to match all
#  required parameters.  If the first template doesn't match, then
#  the next is tried, and so forth.  If none of the templates match,
#  then an optional -default command is invoked instead.  If there
#  is no -default command, then this script pops up an error.
#
#  Bomb icon by Angel Corral Arias
#  http://www.softicons.com/free-icons/designers/angel-corral-arias
#  used under CreativeCommons 2.5 license
#  http://creativecommons.org/licenses/by-nc-nd/2.5/
#
# ======================================================================
# \
exec wish "$0" ${1+"$@"}
# wish executes the rest...

package require Img
set xicon [image create photo -data {
iVBORw0KGgoAAAANSUhEUgAAAA0AAAAMCAYAAAC5tzfZAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ
bWFnZVJlYWR5ccllPAAAAyRpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp
bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6
eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuMC1jMDYxIDY0LjE0
MDk0OSwgMjAxMC8xMi8wNy0xMDo1NzowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo
dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw
dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS
ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD
cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENTNS4xIE1hY2ludG9zaCIgeG1wTU06SW5zdGFu
Y2VJRD0ieG1wLmlpZDozRUI5QzRFOTc5NzYxMUUyOTkzRkExQTM2NTkxNTYzRCIgeG1wTU06RG9j
dW1lbnRJRD0ieG1wLmRpZDozRUI5QzRFQTc5NzYxMUUyOTkzRkExQTM2NTkxNTYzRCI+IDx4bXBN
TTpEZXJpdmVkRnJvbSBzdFJlZjppbnN0YW5jZUlEPSJ4bXAuaWlkOjNFQjlDNEU3Nzk3NjExRTI5
OTNGQTFBMzY1OTE1NjNEIiBzdFJlZjpkb2N1bWVudElEPSJ4bXAuZGlkOjNFQjlDNEU4Nzk3NjEx
RTI5OTNGQTFBMzY1OTE1NjNEIi8+IDwvcmRmOkRlc2NyaXB0aW9uPiA8L3JkZjpSREY+IDwveDp4
bXBtZXRhPiA8P3hwYWNrZXQgZW5kPSJyIj8+wQWuxwAAAINJREFUeNpi/P//PwOpgBGIBYHYGE18
DxJbCYox5FYB8X8knAYVBxn2Dkm8HNlkQTTJu1DT7yKJ7cbmVBc0296hsQVx+bEDTSMMhyIrYkLT
dBaLQe9xiMND6R0Om87g0rQbzQ/laBrL0TWgK4DF2xkc4mAGtjjCFqKgKBBkJCcZAQQYAIP5RJPC
I+hNAAAAAElFTkSuQmCC
}]

set bombicon [image create photo -data {
[encoded data, 14553 characters]
1+V1+S6V/x/xfqgoLz3uJQAAAABJRU5ErkJggg==
}]

option add *side*background #bbb startupFile
option add *Text.font {Helvetica -14} startupFile
option add *Text.borderWidth 0 startupFile
option add *warn.close.relief flat startupFile
option add *warn.close.overRelief raised startupFile

set Wait 0  ;# non-zero => wait to exit (for warnings)
set ParamTypes {file directory}

# ----------------------------------------------------------------------
#  MAIN SCREEN -- used to display major failures
# ----------------------------------------------------------------------
wm title . "Oops! Error"
wm withdraw .

frame .cntls
pack .cntls -side bottom -fill x
frame .cntls.div -height 1 -borderwidth 0 -background black
pack .cntls.div -fill x
button .cntls.ok -text "OK" -default active -command {exit 1}
pack .cntls.ok -padx 10 -pady 10

frame .side
pack .side -side left -fill y
label .side.icon -image $bombicon
pack .side.icon -side top -padx 10 -pady 10

frame .info -width 4i -height 1i
pack .info -expand yes -fill both -padx 10 -pady {10 0}
pack propagate .info off
text .info.message -font {Helvetica -14} -wrap none
pack .info.message -expand yes -fill both

bind .info <Map> {text_message_size %W}

.info.message tag configure heading -font {Helvetica -18 bold} -spacing1 6 -spacing3 10
.info.message tag configure first -spacing1 6
.info.message tag configure code -font {Courier -14} -lmargin1 10
.info.message tag configure codebold -font {Courier -14 bold} -lmargin1 10

proc fail {message} {
    text_message .info.message $message
    update idletasks

    set x0 [expr {([winfo screenwidth .]-[winfo reqwidth .])/2}]
    set y0 [expr {([winfo screenheight .]-[winfo reqheight .])/2}]
    wm geometry . +$x0+$y0

    wm withdraw .warn
    wm deiconify .
    raise .
    focus .cntls.ok

    vwait forever
}

# insert error text into a text widget (with appropriate styles)
proc text_message {win mesg {how -overwrite}} {
    puts stderr "$mesg"

    $win configure -state normal
    if {$how eq "-overwrite"} {
        $win delete 1.0 end
    }

    set first 1
    foreach line [split $mesg \n] {
        if {[regexp {== *(.+) *==} $line match title]} {
            # insert a line of text with the "heading" style
            $win insert end "$title\n" heading
        } elseif {[regexp {^!!} $line]} {
            # insert a line of text with the "code" style
            # make @@type(name) parts bold
            $win insert end " " code

            set line [string range $line 2 end]
            while {[regexp -indices {@@([a-zA-Z]+)\(([^)]+)\)} $line param type name]} {
                foreach {s0 s1} $param break
                set pre [string range $line 0 [expr {$s0-1}]]
                $win insert end $pre code
                set param [string range $line $s0 $s1]
                $win insert end $param codebold
                set line [string range $line [expr {$s1+1}] end]
            }
            if {[string length $line] > 0} {
                $win insert end $line code
            }
            $win insert end "\n" code
        } else {
            # insert a normal line of text
            if {$first} {
                $win insert end "$line\n" first
            } else {
                $win insert end "$line\n"
            }
        }
        set first 0
    }
    $win configure -state disabled

    # check the size on next configure for parent container
    after idle [list text_message_size [winfo parent $win]]
}

# adjust the size of the frame containing the text info area
proc text_message_size {win} {
    update
    set changed 0

    foreach {x0 x1} [$win.message xview] break
    if {$x1-$x0 > 0 && $x1-$x0 < 1 && [winfo ismapped $win]} {
        set neww [expr {[winfo width $win.message]/($x1-$x0)}]
        if {$neww > [winfo screenwidth $win]} {
            set neww [expr {[winfo screenwidth $win]-200}]
        }
        $win configure -width $neww
        set changed 1
    }

    foreach {y0 y1} [$win.message yview] break
    if {$y1-$y0 > 0 && $y1-$y0 < 1 && [winfo ismapped $win]} {
        set newh [expr {[winfo height $win.message]/($y1-$y0)}]
        if {$newh > [winfo screenheight $win]} {
            set newh [expr {[winfo screenheight $win]-50}]
        }
        $win configure -height $newh
        set changed 1
    }
    if {$changed} {
        after idle [list text_message_size $win]
    }
}

# ----------------------------------------------------------------------
#  POPUP WARNINGS -- used to display warnings down in the corner
# ----------------------------------------------------------------------
toplevel .warn -borderwidth 2 -relief solid
wm overrideredirect .warn on
wm withdraw .warn

frame .warn.side
pack .warn.side -side left -fill y
label .warn.side.icon -image $bombicon
pack .warn.side.icon -side top -padx 10 -pady 10

frame .warn.info -width 2i -height 0.5i
pack .warn.info -expand yes -fill both -padx 10 -pady {10 0}
pack propagate .warn.info off
text .warn.info.message -font {Helvetica -12} -wrap none
pack .warn.info.message -expand yes -fill both

bind .warn.info <Map> {text_message_size %W}
bind .warn.info.message <Control-ButtonPress-1> {text_message_size [winfo parent %W]}

.warn.info.message tag configure heading -font {Helvetica -14 bold} -spacing1 6 -spacing3 10
.warn.info.message tag configure first -spacing1 6
.warn.info.message tag configure code -font {Courier -12} -spacing1 2 -lmargin1 10
.warn.info.message tag configure codebold -font {Courier -12 bold} -lmargin1 10

button .warn.close -image $xicon -command {wm withdraw .warn; set Wait 0}
place .warn.close -relx 1 -rely 0 -anchor ne

proc warn {message} {
    global Wait

    # always start with a "Warning" heading
    set info [.warn.info.message get 1.0 end-1char]
    if {$info eq ""} {
        text_message .warn.info.message "== Warning =="
    }

    text_message .warn.info.message $message -append
    update idletasks

    # put this popup in the lower-right corner
    wm geometry .warn -0-0

    wm deiconify .warn
    raise .warn

    # don't exit the program until the popup is dismissed
    set Wait 1
}

# ----------------------------------------------------------------------
#  Load info from a parameter definition file
# ----------------------------------------------------------------------
set Params(all) ""
set Params(orig) ""

if {[info exists env(TOOL_PARAMETERS)]} {
    # if we can't find the file, wait a little
    set ntries 25
    while {$ntries > 0 && ![file exists $env(TOOL_PARAMETERS)]} {
        after 200
        incr ntries -1
    }

    if {![file exists $env(TOOL_PARAMETERS)]} {
        # still no file after all that? then bail out!
        fail "== Tool Invocation Error ==\nCan't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\nFile not found."

    } elseif {[catch {
        # read the file and parse the contents
        set fid [open $env(TOOL_PARAMETERS) r]
        set info [read $fid]
        close $fid
    } result] != 0} {
        fail "== Tool Invocation Error ==\nCan't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\n$result"

    } else {
        # parse the contents of the tool parameter file
        set num 1
        foreach line [split $info \n] {
            set line [string trim $line]
            if {$line eq "" || [regexp {^#} $line]} {
                continue
            }

            if {[regexp {^([a-zA-Z]+)(\([^)]+\))?\:(.*)} $line match type name value]} {
                if {$name ne ""} {
                    lappend Params(orig) "$type$name:$value"
                } else {
                    lappend Params(orig) "${type}(#$num):$value"
                }

                if {[lsearch $ParamTypes $type] < 0} {
                    fail "== Tool Invocation Error ==\nInvalid parameter \"$type$name\"\nType should be one of the following:\n!![join $ParamTypes {, }]"
                }

                switch -- $type {
                    file {
                        if {![file readable $value]} {
                            warn "File not readable:\n!!$value"
                            set last [lindex $Params(orig) end]
                            set Params(orig) [lreplace $Params(orig) end end "$last (ignored)"]
                            continue
                        } elseif {[file isdirectory $value]} {
                            warn "File is not a plain file:\n!!$value"
                            set last [lindex $Params(orig) end]
                            set Params(orig) [lreplace $Params(orig) end end "$last (ignored)"]
                            continue
                        }
                    }
                    directory {
                        if {![file readable $value]} {
                            warn "Directory not readable:\n!!$value"
                            set last [lindex $Params(orig) end]
                            set Params(orig) [lreplace $Params(orig) end end "$last (ignored)"]
                            continue
                        } elseif {![file isdirectory $value]} {
                            warn "Not a directory:\n!!$value"
                            set last [lindex $Params(orig) end]
                            set Params(orig) [lreplace $Params(orig) end end "$last (ignored)"]
                            continue
                        }
                    }
                }

                set Params($num-type) $type
                set Params($num-value) $value
                lappend Params(all) $num

                if {$name ne ""} {
                    # name is like "(foo)" -- get rid of ()'s
                    set name [string range $name 1 end-1]
                    set Params($name>num) $num
                    set Params($num>name) $name
                }
                incr num
            }
        }
    }
}

# ----------------------------------------------------------------------
#  Parse command line args...
# ----------------------------------------------------------------------
set default ""

if {$argc == 0} {
    fail "== Tool Invocation Error ==\n\nUsage:\n!!toolparam command ?-or command ...? ?-default command?"
}
set templates [list [lindex $argv 0]]
set argv [lrange $argv 1 end]

while {[llength $argv] > 0} {
    set arg [lindex $argv 0]
    set argv [lrange $argv 1 end]

    switch -- $arg {
        -or {
            if {[llength $argv] == 0} {
                fail "== Tool Invocation Error ==\nMissing value for -or option\n\nShould be:\n!!toolparam command ?-or command ...? ?-default command?"
            }
            lappend templates [lindex $argv 0]
            set argv [lrange $argv 1 end]
        }
        -default {
            if {[llength $argv] == 0} {
                fail "== Tool Invocation Error ==\nMissing value for -default option\n\nShould be:\n!!toolparam command ?-or command ...? ?-default command?"
            }
            set default [lindex $argv 0]
            set argv [lrange $argv 1 end]
        }
        default {
            fail "== Tool Invocation Error ==\nBad option \"$arg\"\n\nShould be:\n!!toolparam command ?-or command ...? ?-default command?"
        }
    }
}

#
# Scan through all templates and look for a match.  Substitute as
# many parameters as we can.  If we find outright errors in the
# template (e.g., wrong type for a parameter), then we must complain
# and fail.
#
# If we find a matching template, then check for other subtle errors.
# If a template uses only 2 of 3 parameters (extra parameters left
# over), then warn about that.  Or if there are parameters but no
# matching templates, warn about that and use the default command.
#
set cmd ""
if {[llength $Params(all)] > 0} {
    foreach str $templates {
        set orig $str
        set match 1
        set paramsLeftOver $Params(all)

        # look for any @@type(name) fields in the command string
        while {[regexp {@@([a-zA-Z]+)\(([^)]+)\)} $str param type name]} {
            if {$type ne "" && [lsearch $ParamTypes $type] < 0} {
                fail "== Tool Invocation Error==\nError in argument \"$param\"\nBad parameter type \"$type\"\n\nShould be one of:\n!![join $ParamTypes {, }]"
            }

            # name can be something like "#2" or "foo"
            set num 0
            if {[regexp {^#} $name]} {
                set num [string range $name 1 end]
                if {![string is integer -strict $num] || $num <= 0} {
                    fail "== Tool Invocation Error ==\nError in argument \"$param\"\nBad parameter identifier \"$name\"\nShould be #N or parameter name"
                }
            } elseif {[info exists Params($name>num)]} {
                set num $Params($name>num)
            }

            # see if the requested parameter has been specified
            if {![info exists Params($num-type)]} {
                # this parameter set doesn't have the specified param
                set match 0
                break
            } elseif {$type ne "" && $Params($num-type) ne $type} {
                # parameter type doesn't match what was requested
                set match 0
                break
            }

            # substitute the parameter value into the template
            set str [string map [list $param $Params($num-value)] $str]

            # mark this parameter off the list
            set i [lsearch $paramsLeftOver $num]
            if {$i >= 0} {
                set paramsLeftOver [lreplace $paramsLeftOver $i $i]
            }
        }

        if {$match} {
            # found a template command that works!
            set cmd $str

            # if there are any parameters left over, warn about this
            if {[llength $paramsLeftOver] > 0} {
                set plist ""
                foreach num $paramsLeftOver {
                    if {[info exists Params($num>name)]} {
                        set name $Params($num>name)
                    } else {
                        set name "#$num"
                    }
                    lappend plist "$Params($num-type)($name):$Params($num-value)"
                }
                warn "Extra parameters have been ignored:\n!![join $plist \n!!]\nFor command:\n!!$orig"
            }
            break
        }
    }
}

# if a template didn't match, use -default
if {$cmd eq ""} {
    if {$default eq ""} {
        set cmdlist [join $templates "\n!!"]
        fail "== Tool Invocation Error ==\nMissing required parameters.\n\nShould match one of the following commands:\n!!$cmdlist\n\nInput parameters:\n!![join $Params(orig) \n!!]"
    } else {
        if {[llength $Params(all)] > 0 && [llength $templates] > 0} {
            set cmdlist [join $templates "\n!!"]
            warn "Specified parameters did not match\nany of the following invocations:\n!!$cmdlist\n\nInput parameters:\n!![join $Params(orig) \n!!]"
        }
        set cmd $default
    }
}

# execute the command that we finally settled on
if {[catch {eval exec $cmd} result]} {
    puts stderr $result
    set status 1
} else {
    puts stdout $result
    set status 0
}

# need to wait for warning messages?
if {$Wait} {
    vwait Wait
}
exit $status
