RemoteSupportTool/src/lib/app-support/utils.tcl

#!/usr/bin/env tclsh
#
# Copyright (c) 2015-2017 OpenIndex.de
#
# 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.
#

namespace eval ::support::utils {

  # Center a window on screen.
  proc center_window {w {width 640} {height 480}} {
    set x [expr { ( [winfo vrootwidth  $w] - $width  ) / 2 }]
    set y [expr { ( [winfo vrootheight $w] - $height ) / 2 }]
    wm geometry $w ${width}x${height}+${x}+${y}
  }

  # Load an image from application data.
  proc load_image_file {name} {
    set path [file join $::support::DATA_DIR $name]
    if {[file exists $path]} {
      return [image create photo -format png -file $path]
    }
    puts "Can't find an image at '$path'!"
    return
  }

  # Get path to temporary directory.
  proc get_temp_dir {} {
    global env

    if {[info exists env(TMPDIR)]} {
      return $env(TMPDIR)
    }
    if {[info exists env(TEMPDIR)]} {
      return $env(TEMPDIR)
    }
    if {[info exists env(TEMP)]} {
      return $env(TEMP)
    }
    if {[info exists env(TMP)]} {
      return $env(TMP)
    }
    if {![is_windows] && [file writable /usr/tmp]} {
      return /usr/tmp
    }
    if {![is_windows] && [file writable /tmp]} {
      return /tmp
    }
    if {[info exists env(HOME)]} {
      return $env(HOME)
    }
    return $::support::APP_DIR
  }

  # Test, if the program runs on Mac OS X / Darwin.
  proc is_darwin {} {
    global tcl_platform
    set os [string tolower $tcl_platform(os)]
    return [string match "darwin*" $os]
  }

  # Test, if the program runs on Linux.
  proc is_linux {} {
    global tcl_platform
    set os [string tolower $tcl_platform(os)]
    return [string match "linux*" $os]
  }

  # Test, if the program runs on Windows.
  proc is_windows {} {
    global tcl_platform
    set os [string tolower $tcl_platform(os)]
    return [string match "windows*" $os]
  }

  # Get a list of child processes.
  proc process_children {processIds} {

    if {[is_windows]} {
      error "Windows is not supported."
    }

    set children [list]
    if {[llength $processIds] < 1} {
      return $children
    }
    foreach processId $processIds {
      if {[is_darwin]} {
        lappend children {*}[process_children_darwin $processId]
      } elseif {[is_linux]} {
        lappend children {*}[process_children_linux $processId]
      }
    }
    return $children
  }

  # Get a list of child processes on Mac OS X.
  proc process_children_darwin {processId} {
    if {[catch {exec bash << "ps -o ppid= -o pid= -A | awk '\$1 == $processId\{print \$2\}'"} result]} {
      puts "Can't fetch children of process '$processId'!"
      puts $::errorInfo
      return [list]
    }
    return [split [string trim $result] "\n"]
  }

  # Get a list of child processes on Linux.
  proc process_children_linux {processId} {
    if {[catch {exec bash << "ps -o ppid= -o pid= -A | awk '\$1 == $processId\{print \$2\}'"} result]} {
      puts "Can't fetch children of process '$processId'!"
      puts $::errorInfo
      return [list]
    }
    return [split [string trim $result] "\n"]
  }

  # Test, if a certain process is running.
  proc process_is_running {processId} {
    if {[is_darwin] && [process_is_running_darwin $processId]} {
      return 1
    }
    if {[is_linux] && [process_is_running_linux $processId]} {
      return 1
    }
    if {[is_windows] && [process_is_running_windows $processId]} {
      return 1
    }
    return 0
  }

  # Test, if a certain process is running on Mac OS X.
  proc process_is_running_darwin {processId} {

    if {[catch {exec bash << "ps -p $processId -o state="} result]} {
      puts "Can't fetch process '$processId'!"
      puts $::errorInfo
      return 0
    }

    set state [lindex [split [string trim $result] "\n"] end]
    puts "Checking process $processId: $state"
    set s [string index  $state 0]
    if {$s=="I" || $s=="R" || $s=="S" || $s=="U"} {
      return 1
    }
    return 0
  }

  # Test, if a certain process is running on Linux.
  proc process_is_running_linux {processId} {
    if {[catch {exec bash << "ps -p $processId -o state="} result]} {
      puts "Can't fetch process '$processId'!"
      puts $::errorInfo
      return 0
    }

    set state [lindex [split [string trim $result] "\n"] end]
    puts "Checking process $processId: $state"
    set s [string index  $state 0]
    if {$s=="D" || $s=="R" || $s=="S" || $s=="W"} {
      return 1
    }
    return 0
  }

  # Test, if a certain process is running on Windows.
  proc process_is_running_windows {processId} {
    if {[catch {exec tasklist "/FI" "PID eq $processId" "/FO" "CSV" "/NH"} result]} {
      puts "Can't fetch process '$processId'!"
      puts $::errorInfo
      return 0
    }

    set result [string trim $result]
    puts "Checking process $processId: $result"
    if {[string first "\"$processId\"" $result] > -1} {
      return 1
    }
    return 0
  }

  # Stop a currently running process.
  proc process_kill {processId} {
    if {[is_darwin]} {
      return [process_kill_darwin $processId]
    }
    if {[is_linux]} {
      return [process_kill_linux $processId]
    }
    if {[is_windows]} {
      return [process_kill_windows $processId]
    }
    return 0
  }

  # Stop a currently running process on Mac OS X.
  proc process_kill_darwin {processId} {
    puts "Killing process '$processId'."
    if {[catch {exec bash << "kill $processId"} result]} {
      puts "Can't kill process '$processId'!"
      puts $::errorInfo
      return 0
    }
    return 1
  }

  # Stop a currently running process on Linux.
  proc process_kill_linux {processId} {
    puts "Killing process '$processId'."
    if {[catch {exec bash << "kill $processId"} result]} {
      puts "Can't kill process '$processId'!"
      puts $::errorInfo
      return 0
    }
    return 1
  }

  # Stop a currently running process on Windows.
  proc process_kill_windows {processId} {
    error "Not implemented yet!"
  }

  # Make a modal window.
  proc modal_init {id} {
    wm transient $id $::support::ApplicationWindow::ID
    raise $id
    focus $id
    grab $id
  }

  # Release a modal window.
  proc modal_release {id} {
    grab release $id
    wm withdraw $id
    update
    destroy $id
  }

  # Open a website in the web browser.
  proc open_browser {url} {
    # open is the OS X equivalent to xdg-open on Linux, start is used on Windows
    set commands {xdg-open open start}
    foreach browser $commands {
      if {$browser eq "start"} {
        set command [list {*}[auto_execok start] {}]
      } else {
        set command [auto_execok $browser]
      }
      if {[string length $command]} {
        break
      }
    }

    if {[string length $command] == 0} {
      return -code error "couldn't find browser"
    }
    if {[catch {exec {*}$command $url &} error]} {
      return -code error "couldn't execute '$command': $error"
    }
  }

  # Get the path of a certain application.
  proc get_application {name} {
    if {[is_darwin] || [is_linux]} {
      return [exec which $name]
    }
    if {[is_windows]} {
      return [exec where $name]
    }
    error "Can't get application path for this operating system!"
  }

  # Get a recursive list of files in a directory.
  proc get_files {{dir .}} {
    set res {}
    foreach i [lsort [glob -nocomplain -dir $dir *]] {
      if {[file type $i] eq {directory}} {
        eval lappend res [get_files $i]
      } else {
        lappend res $i
      }
    }
    set res
  }
}