software/tcl/modem_status.tcl

   1 #!/usr/bin/wish
   2 set lockfile /var/lock/LCK..ttyS1
   3 set mgettypid /var/run/mg-pid.ttyS1
   4 set delay 500
   5 option add *Background yellow widgetDefault
   6 # These are system programs, often started from special account, so we
   7 # are not interesting in the name of invoking user
   8 array set systemprog {
   9   mgetty mgetty
  10   pppd "PPP link"
  11   ifcico "FIDO link"
  12   uucico "UUCP link"
  13 }
  14
  15 if [catch {package require Tclx}] {
  16    proc kill {signal pid} {
  17        regsub {^SIG} $signal {} signal
  18        exec /bin/kill -$signal $pid
  19    }
  20
  21 }
  22 wm overrideredirect . y
  23 rename send {}
  24 set image [image create photo -data {
  25 R0lGODlhMAAwAKUAAAAAAHGBcVmBcVlpYSAwIHFxaVCBhZ2hnUhZUAgICNbi3iAgMDBQUEBp
  26 YSAwMBAQEFBAUJ2utkAwMI2NlUBAMAAQEHGBjb7KxoWhnRAQIEAwQFBhYcbOzjBISBAYEAAQ
  27 AEBAQJWVlWFxhTAwIGGBhebi5hggGGFpcUBAUBAAEK6ytjAgMO7q7kBQUCA4OIWBcTAwMGGB
  28 lTBAMBgoIFBhcWmVjYVxhVBxcf///6XGxkhIQFlZWUBQYTAwQJ2hpTBAQCH5BAEAADgALAAA
  29 AAAwADAAAAb+QJxwSCwaj8ikcslsOp/QKPPxswWs2KvOJmWurr5LzncIhchmsi9yufgCp1EX
  30 95uo3JYGT4/g/X4uPQ6Afx0MKA0iNWwXGA9NJiEqEyc0DTstKD8LBBkPKR8pAKCioAuDHS0N
  31 GwInPwBLFSEbMC2WfoImHgkAvb6/vR4OLh0IGw0OJigeSzo3D70OLTowHhkEvT8t2zzbLTwu
  32 MwC1KAg0z6MyKLBJEzzQwSgzGS68wPe9FRY3NzULvgtcZDACb8aFFvCiLWghyleSX4pE/HrQ
  33 gxmRGT6gIfDBw8MvEy4c4Bvp60MOcb4euPhhYgi0AxMA1JjQwmPJdThIkmyxwMP+g08eYPzo
  34 MQQhAB8/ItTg4SDBB18idY7EsWAGqkA/UDAYsiPHTw9KEaAg4FPYK6loAXjwsECdEGgFVDzi
  35 UOOEng6cHjxNy7eXkB3QIMghQcNBhr0ARmigAEGGBBgaRqyQsYKAhhkzZPj8+SBBCnvAhCDI
  36 AYKdU2A/SmCoUcNCjRg5XNRQ4SAGbRK0YXTo8CfqPRzQwLLDNzoGCREnRGxY4WCDgwUbOKF4
  37 rg6Eph5TdVwQOQTfGhLGRQigUeNYjEskusXogIL9nx/QjgDYwWFAd79DfPiwcFyACBLbWRAB
  38 DCREQIAFKiwAgyYg/KABL0ds8BMESnAwAQkkGCBCA4X+uUCLA4VJcwoI7v0hzhE2cGADDElQ
  39 oEAN/4lwAw0bWLDBDiRgEkMmJGjCoAwaYCMfFRNUgMQGHMSgoX8NwOYAbrVF4MBsDvTw3h8w
  40 4EeEDRRooGURE1zQn4w7fOgcdNIR0FaDGsjQAwyiGLGBFRQiwUEE4fk3I2FN6lHDNjEc8l4P
  41 blbADhG+zIBECgr4MOae28UQwQq4HRjBiEDKAEM1hw7xwwk+hNCSES2wgEGG4t3AoQMOINMc
  42 qy2wauUfhMKAUhEa7IBSp73Y8KJ/yd1wwgY07mBsCwhkogMKILSpwaa2fvmWCSdcMIADD0T7
  43 QAgcYCCChsLOeEMOKpBrrgr07TVopSAwEBBnESYccMADA6gAgxUADFCCAjnoecKMG5zAwsAE
  44 D1wAm25C24IM0gIHgAk+YNCgDQCAoEAJF0SAwYU3DEDjMTv04Y0mf6AwwAknhFADDU8ZAUAC
  45 VhzQZQAAnHBxBNO8kMXOV/S8cwHJ1kDCP0hkA0C2AExQAgc+dGBoXxM5wMMi3CnxiwVLW+BA
  46 Q1AD1IEIGOzQ6UMAYFBCDjf80/UvBPxww2pjF122ah2t/YsHMmxAggVxywcABN0ykIHdvpjQ
  47 QwMWbOXE0Qg0gAJidgtTThSE49NyF5X/NkdOmfe9+eeghy766KSXbvrpqBsRBAA7
  48 }]
  49 button .b -image $image  -command "do_something"
  50 label  .l -text "Phone free" -font 6x10
  51 pack .b .l -side top -expand y -fill both
  52 after idle check_phone
  53
  54 proc check_phone {} {
  55   global lockfile systemprog delay
  56   if [catch {
  57   if [file exists $lockfile] {
  58     set f [open $lockfile]
  59     gets $f line
  60     close $f
  61     set pid [string trimleft [lindex  $line 0] 0]
  62     set command "kill_process $pid"
  63     if [catch {set f [open "/proc/$pid/cmdline"]}] {
  64       set message "Stale lock"
  65       set command {}
  66     } else {
  67     set cmdname [lindex [split [read $f] "\0"] 0]
  68     close $f
  69     if [regexp {^-} $cmdname] {
  70       set message "User [file attributes /proc/$pid -owner]"
  71
  72     } else {
  73       set message [file tail $cmdname]
  74       if {![info exists systemprog($message)]} {
  75         append message "\n([file attributes /proc/$pid -owner])"
  76       } else {
  77         set message $systemprog($message)
  78       }
  79     }
  80   }
  81   } else {
  82       set message "Free"
  83       set command "auto_answer"
  84   }
  85
  86   .l configure -text "$message"
  87   .b configure -command $command
  88   } msg ] {
  89     global argv0
  90     puts stderr "$argv0: $msg"
  91   }
  92   after $delay check_phone
  93 }
  94
  95 proc auto_answer {} {
  96   global mgettypid
  97   set f [open $mgettypid]
  98   gets $f pid
  99   close $f
 100   kill SIGUSR1 $pid
 101 }
 102
 103 proc kill_process {pid} {
 104   if {[tk_messageBox -title Configrm -message \
 105         "Really kill [.l cget -text]?" -type yesno] == "yes" } {
 106           kill SIGHUP $pid
 107   }
 108 }
 109
 110