]> wagner.pp.ru Git - sites/home_page.git/blob - software/tcl/modem_status.tcl
grandpa picture
[sites/home_page.git] / 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