00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## Process - interface for a forked process. 00013 ## \ingroup YadaScheduler 00014 ## 00015 ## \author Michael Daum 00016 ## 00017 ## $Id: Process.tcl,v 1.16 2004/10/15 17:21:57 micha Exp $ 00018 ## ---------------------------------------------------------------------------- 00019 class Process { 00020 00021 # variables ---------------------------------------------------------------- 00022 public variable logFile "" 00023 public variable printCommand "" 00024 public variable sync 0 00025 public variable job "" 00026 public variable consumerCommand "" 00027 public variable showProgress 0 00028 public variable bufferSize 81920 00029 00030 private variable _pid -1 00031 private variable _pipe "" 00032 private variable _logFileId -1 00033 00034 # methods ------------------------------------------------------------------ 00035 public method start {command}; ## \type TclString \virtual 00036 public method stop {}; ## \virtual 00037 public method tell {args}; ## \type TclList 00038 public method isAlive {} 00039 public method wait {} 00040 public method signal {signo}; ## \type TclNumber 00041 public method interrupt {} 00042 public method term {} 00043 public method kill {} 00044 public method nice {{prio 10}}; ## \type TclNumber 00045 public method getPid {} 00046 public method getJobState {} 00047 public method getPassedJobStates {} 00048 00049 constructor {args} {}; ## \type TclList 00050 destructor {} 00051 00052 private method _readPipe {} 00053 protected method _print {text}; ## \type TclString 00054 00055 }; 00056 00057 ## ---------------------------------------------------------------------------- 00058 ## constructor 00059 ## ---------------------------------------------------------------------------- 00060 body Process::constructor {args} { 00061 set printCommand [code puts -nonewline] 00062 eval configure $args 00063 } 00064 00065 ## ---------------------------------------------------------------------------- 00066 ## destructor 00067 ## ---------------------------------------------------------------------------- 00068 body Process::destructor {} { 00069 00070 # terminate the process 00071 if {$_pid > 0} { 00072 if {[catch {exec kill $_pid} errMsg]} { 00073 _print "ERROR: $errMsg\n$::errorInfo\n" 00074 } 00075 } 00076 set _pid -1 00077 00078 # close the command pipe 00079 if {$_pipe != ""} { 00080 fileevent $_pipe readable "" 00081 catch {close $_pipe} 00082 set _pipe "" 00083 } 00084 00085 # close the logfile 00086 if {$_logFileId > 0} { 00087 catch {close $_logFileId} 00088 set _logFileId -1 00089 00090 # compress logFile 00091 regsub {^(.*)\.gz$} $logFile {\1} clearLogFile 00092 if {[file exists $clearLogFile]} { 00093 if {[catch {exec gzip -f [glob $clearLogFile]} errMsg]} { 00094 _print "ERROR: $errMsg\n$::errorInfo\n" 00095 } 00096 } 00097 } 00098 00099 # call the consumer 00100 if {$consumerCommand != "" && $job != ""} { 00101 00102 # this process can only be consumed once 00103 set thisConsumerCommand "$consumerCommand" 00104 set consumerCommand "" 00105 if {[catch {$thisConsumerCommand $job} errMsg]} { 00106 _print "ERROR: $errMsg\n$::errorInfo\n" 00107 } 00108 } 00109 00110 # unregister from machine 00111 if {$job != ""} { 00112 set machine "" 00113 catch {set machine [$job cget -machine]} 00114 if {$machine != ""} { 00115 $machine stopJob $job 00116 } 00117 } 00118 } 00119 00120 ## ---------------------------------------------------------------------------- 00121 ## getPid 00122 ## ---------------------------------------------------------------------------- 00123 body Process::getPid {} { 00124 return $_pid 00125 } 00126 00127 ## ---------------------------------------------------------------------------- 00128 ## start 00129 ## ---------------------------------------------------------------------------- 00130 body Process::start {command} { 00131 00132 if {$logFile == ""} { 00133 set _logFileId -1 00134 } else { 00135 regsub {^(.*)\.gz$} $logFile {\1} clearLogFile 00136 set dirname [file dirname $clearLogFile] 00137 file mkdir $dirname 00138 set _logFileId [open $clearLogFile w] 00139 } 00140 00141 if {[catch {set _pipe [open "|bash -c \"$command 2>&1 \"" r+]} errMsg]} { 00142 _print "ERROR: $errMsg\n$::errorInfo\n" 00143 stop 00144 return 0 00145 } 00146 00147 set _pid [pid $_pipe] 00148 00149 fconfigure $_pipe -blocking 0 -translation binary -buffersize $bufferSize 00150 fileevent $_pipe readable [code $this _readPipe ] 00151 00152 return $_pid 00153 } 00154 00155 ## ---------------------------------------------------------------------------- 00156 ## stop 00157 ## ---------------------------------------------------------------------------- 00158 body Process::stop {} { 00159 itcl::delete object $this 00160 } 00161 00162 ## ---------------------------------------------------------------------------- 00163 ## _readPipe 00164 ## ---------------------------------------------------------------------------- 00165 body Process::_readPipe {} { 00166 00167 # temporarily disable read pipe event 00168 fileevent $_pipe readable "" 00169 00170 if {$_pipe == "" || [eof $_pipe]} { 00171 after idle [code $this stop] 00172 return 00173 } 00174 00175 set buffer [read $_pipe $bufferSize] 00176 00177 if {$_logFileId > 0} { 00178 puts -nonewline $_logFileId "$buffer" 00179 flush $_logFileId 00180 } 00181 00182 if {$showProgress} { 00183 _print $buffer 00184 } 00185 00186 # reenable read pipe event 00187 fileevent $_pipe readable [code $this _readPipe] 00188 } 00189 00190 ## ---------------------------------------------------------------------------- 00191 ## _print 00192 ## ---------------------------------------------------------------------------- 00193 body Process::_print {text} { 00194 00195 if {$printCommand != ""} { 00196 $printCommand "$text" 00197 } 00198 } 00199 00200 00201 ## ---------------------------------------------------------------------------- 00202 ## wait 00203 ## ---------------------------------------------------------------------------- 00204 body Process::wait {} { 00205 00206 if {$_pid > 0 && ![eof $_pipe]} { 00207 flush $_pipe 00208 vwait [scope _pid] 00209 } 00210 } 00211 00212 ## ---------------------------------------------------------------------------- 00213 ## isAlive 00214 ## ---------------------------------------------------------------------------- 00215 body Process::isAlive {} { 00216 global tcl_platform 00217 00218 switch $tcl_platform(os) { 00219 "SunOS" { 00220 set psCommand "ps -a" 00221 } 00222 "Linux" { 00223 set psCommand "ps -x" 00224 } 00225 "Windows NT" { 00226 set psCommand "ps" 00227 } 00228 "Windows 95" { 00229 set psCommand "ps" 00230 } 00231 "Windows 98" { 00232 set psCommand "ps" 00233 } 00234 default { 00235 error "unknown platfprm $tcl_platform(os)" 00236 } 00237 } 00238 00239 #puts "ps='[eval exec $psCommand]'" 00240 00241 if {[catch {set psInfo [eval exec $psCommand | grep $_pid | grep -v grep]}]} { 00242 return 0 00243 } 00244 00245 if {$psInfo != ""} { 00246 return 1 00247 } 00248 00249 return 0 00250 } 00251 00252 ## ---------------------------------------------------------------------------- 00253 ## interrupt 00254 ## ---------------------------------------------------------------------------- 00255 body Process::interrupt {} { 00256 signal 2 00257 } 00258 00259 ## ---------------------------------------------------------------------------- 00260 ## term 00261 ## ---------------------------------------------------------------------------- 00262 body Process::term {} { 00263 signal 15 00264 } 00265 00266 ## ---------------------------------------------------------------------------- 00267 ## kill 00268 ## ---------------------------------------------------------------------------- 00269 body Process::kill {} { 00270 signal 9 00271 } 00272 00273 ## ---------------------------------------------------------------------------- 00274 ## signal 00275 ## ---------------------------------------------------------------------------- 00276 body Process::signal {signo} { 00277 if {$_pid > 0} { 00278 if {[catch {exec kill -$signo $_pid} errMsg]} { 00279 _print "ERROR: $errMsg\n$::errorInfo\n" 00280 } 00281 } 00282 } 00283 00284 ## ---------------------------------------------------------------------------- 00285 ## tell 00286 ## ---------------------------------------------------------------------------- 00287 body Process::tell {args} { 00288 00289 if {[eof $_pipe]} { 00290 return 00291 } 00292 00293 if {$args == ""} { 00294 return 00295 } 00296 00297 foreach something $args { 00298 # puts "DEBUG: tell `$something'" 00299 puts $_pipe $something 00300 } 00301 00302 if {$sync} { 00303 flush $_pipe 00304 } 00305 } 00306 00307 ## ---------------------------------------------------------------------------- 00308 ## nice 00309 ## ---------------------------------------------------------------------------- 00310 body Process::nice {{prio 10}} { 00311 if {$_pid > 0} { 00312 if {[catch {exec renice $prio $_pid} errMsg]} { 00313 _print "ERROR: $errMsg\n$::errorInfo\n" 00314 } 00315 } 00316 } 00317 00318 ## ---------------------------------------------------------------------------- 00319 ## getJobState 00320 ## ---------------------------------------------------------------------------- 00321 body Process::getJobState {} { 00322 if {$job == ""} { 00323 return "unknown" 00324 } 00325 return [$job getState] 00326 } 00327 00328 ## ---------------------------------------------------------------------------- 00329 ## getPassedJobStates 00330 ## ---------------------------------------------------------------------------- 00331 body Process::getPassedJobStates {} { 00332 if {$job == ""} { 00333 return [list "unknown"] 00334 } 00335 return [$job getPassedStates] 00336 } 00337 00338 ## ---------------------------------------------------------------------------- 00339 ## callback for Process::showProgress 00340 ## showProgress 00341 ## ---------------------------------------------------------------------------- 00342 configbody Process::showProgress { 00343 if {$_logFileId > 0} { 00344 flush $_logFileId 00345 } 00346 } 00347