5749372 [rkeene@sledge /home/rkeene/projects/commander/_commander]$ cat -n local.tcl
   1: proc aim {text} {
   2: 	global SrcAddr CmdAddr
   3: 
   4: 	set args $text
   5: 	set outFile [open "~/tac/.aim-cmd" a+]
   6: 	if {[string tolower [lindex $args 0]]=="/p"} {
   7: 		set targ [lindex $args 1]
   8: 		set args [lrange $args 2 end]
   9: 		puts $outFile "/wm $targ |/usr/local/bin/shmail -f $CmdAddr -s aim $SrcAddr"
  10: #		puts $outFile "/chk 3"
  11: 		puts $outFile "/s $targ"
  12: 	}
  13: 	if {[string tolower [lindex $args 0]]=="/g"} {
  14: 		set targ [lindex $args 1]
  15: 		set args [lrange $args 2 end]
  16: 		puts $outFile "/wma $targ"
  17: #		puts $outFile "/chk 30"
  18: 		puts $outFile "/s $targ"
  19: 	}
  20: 	if {[string tolower [lindex $args 0]]=="/a"} {
  21: 		puts $outFile "/wm * |/usr/local/bin/shmail -f $CmdAddr -s aim $SrcAddr"
  22: 		set args [lrange $args 1 end]
  23: 	}
  24: 	if {[string tolower [lindex $args 0]]=="/b"} {
  25: 		puts $outFile "/wma *"
  26: 		set args [lrange $args 1 end]
  27: 	}
  28: 	if {[string trim $args]!=""} {
  29: 		puts $outFile $args
  30: 	}
  31: 	close $outFile
  32: }
  33: 
  34: 
  35: 
  36: proc google {text} {
  37: 	set ContextForward 25 
  38: 	set ContextBack 15
  39: 	set wrk [split $text]
  40: 	if {[string is integer -strict [lindex $wrk 0]]} {
  41: 		set ContextForward [lindex $wrk 0]
  42: 		if {$ContextForward==0} { set ContextBack 0 }
  43: 		set text [join [lrange $wrk 1 end]]
  44: 	}
  45: 	foreach arg $wrk {
  46: 		if {[llength [split $arg]]>1} { set arg "\"$arg\"" }
  47: 		if {[string trim $arg]!=""} { lappend qlist [string map { \  %20 \" %22 & %26 + %2B } $arg] }
  48: 	}
  49: 	if {![info exists qlist]} { set qlist "" }
  50: 	set q [join $qlist +]
  51: 
  52: 	if {$q!=""} {
  53: 		set query "http://www.google.com/search?btnI=I%27m+Feeling+Lucky&q=$q"
  54: 
  55: 		set res ""
  56: 		catch { set res [exec lynx -source -head -connect_timeout=2 -- $query | grep ^Location] }
  57: 		if { $res == "" } {
  58: 			return "No result / Server down."
  59: 			return
  60: 		}
  61: 
  62: 		set url "[join [lrange [split $res \ ] 1 end] \ ]"
  63: 
  64: 		if {$ContextForward==0} { return "google: $url" }
  65: 
  66: 		set res ""
  67: 		catch { set res [exec lynx -connect_timeout=2 -dump "$url"] }
  68: 
  69: 		if {$res==""} { return "google: $url \[down\]" }
  70: 
  71: 		set Webdata ""
  72: 		foreach ln [split $res \n] {
  73: 			set ln [string trim $ln]
  74: 			regsub -all {\[[0-9]*\]} $ln {} ln
  75: 			if {$ln=="References"} { break }
  76: 			if {[string match "__________*" $ln]} { continue }
  77: 			foreach pt [split $ln] {
  78: 				set pt [string trim $pt]
  79: 				if {$pt!=""} { lappend Webdata $pt }
  80: 			}
  81: 		}
  82: 		if {$Webdata==""} { return "google: $url \[...\]" }
  83: 		set Webdata [join $Webdata]
  84: 
  85: 
  86: 		set Matches 0
  87: 		foreach search $text {
  88: 			set SIdx 0
  89: 			set Cnt 0
  90: 			while {[regexp -nocase -indices -- $search [string range $Webdata $SIdx end] idx]} {
  91: 				incr Cnt
  92: 				lappend Matches [expr [lindex $idx 0]+$SIdx]
  93: 				incr SIdx [lindex $idx 1]
  94: 				if {$Cnt==3} { break }
  95: 			}
  96: 		}
  97: 
  98: 		if {![info exists Matches]} { set Matches "" }
  99: 		if {[llength $Matches]==0} { return "google: $url \[...\]" }
 100: 		foreach idx [lsort -integer $Matches] {
 101: 			set Idx1 [expr $idx-$ContextBack]
 102: 			if {$Idx1<0} { set Idx1 0 }
 103: 			set Idx2 [expr $Idx1+$ContextBack+$ContextForward]
 104: 			if {![info exists PIdx1]} { set PIdx1 $Idx1 }
 105: 			if {![info exists PIdx2]} { set PIdx2 $Idx2 }
 106: 			if {$Idx1<$PIdx2} { set PIdx2 $Idx2; continue } 
 107: 			lappend Idxlist $PIdx1 $PIdx2
 108: 			set PIdx1 $Idx1
 109: 			set PIdx2 $Idx2
 110: 		}
 111: 		lappend Idxlist $PIdx1 $PIdx2
 112: 		foreach {Idx1 Idx2} $Idxlist {
 113: 			lappend Output "[string range $Webdata $Idx1 $Idx2]"
 114: 		}
 115: 		return "$url: [join $Output ...]"
 116: 	}
 117: }
 118: 
 119: 
 120: 
 121: 
 122: proc weather {text} {
 123:   set text [split $text]
 124:   set start 2
 125:   set stop 5
 126: 
 127:   if {[string tolower [lindex $text 0]]=="/a"} { set start 6; set stop 8; set text [lrange $text 1 end] }
 128:   set station [string toupper [lindex $text 0]]
 129: 
 130: #  if {$station == ""} { set station "KBIX" }
 131:   if {![regexp "^\[A-Z0-9\]{4}$" $station]} { return [weather_zip $station [lindex $text 1]] }
 132: 
 133:   catch { set res [exec lynx -connect_timeout=3 -source http://weather.noaa.gov/pub/data/observations/metar/decoded/${station}.TXT] }
 134: 
 135:   if {![info exists res]} { return "" }
 136:   if {$res == ""} { return "" }
 137: 
 138:   set res [split $res \n]
 139: 
 140:   # stupid but it works
 141:   if {[string index $res 1] == "<"} {
 142:     return "Unknown weather station ($station)!"
 143: # FYI
 144:     return "Please see http://www.nws.noaa.gov/oso/siteloc.shtml for a list of weather stations."
 145:   }
 146: 
 147:   set line ""
 148:   for {set i $start} {"[lindex $res $i]" != ""} {incr i} {
 149:     if {$i > $stop} { break }
 150:     set line "$line[lindex $res $i] | "
 151:   }
 152:   set line [string map {:0 "" degrees deg from "" at "" the "" Visibility Vis Temperature Temp Relative Rel Humidity Hum conditions cond Pressure Pres (altimeter) ""} [string range $line 0 end-3]]
 153:   regsub -all {  *} $line { } line
 154:   return "$station: $line"
 155: }
 156: 
 157: 
 158: 
 159: 
 160: proc weather_zip {{zip ""} {DateNum 0}} {
 161:   global STORE_zip
 162:   if {![regexp {^[0-9]{5}$} $zip]} {
 163:     if {[info exists STORE_zip]} { set DateNum $zip; set zip ${STORE_zip} } else { return "Invalid zip code." }
 164:   }
 165:   set STORE_zip $zip
 166: 
 167:   if {$DateNum==""} { set DateNum 0 }
 168: 
 169:   catch { set res [exec lynx -connect_timeout=3 -source "http://www.weather.com/weather/local/${zip}?lswe=&lswa="] } err
 170: 
 171:   if {![info exists res]} { return "" }
 172:   if {$res == ""} { return "" }
 173: 
 174:   set res [split $res \n]
 175:   set date "curr"
 176:   set dates ""
 177:   foreach line $res {
 178:     if {![regexp {<!-- insert .* -->} $line] || [regexp {icon --} $line]} { continue }
 179:     set line [string map {<B> "" </B> ""} $line]
 180:     foreach {name value} [lrange [split $line <>] 1 end] {
 181:        if {![string match "!-- insert *" $name]} { continue }
 182:        regsub -all {(!--\ insert\ |--)} $name {} name
 183:        set value [string trim [string map {&deg; "" &nbsp; " " current "" From "" the "" " at " " " South S North N East E West W east E west W south S north N Unlimited Unl miles mi inches in}  $value]]
 184:        if {$value=="" || [regexp {^(title\ of|event|forecast/temp/or|lasted\ updated)} $name]} { continue }
 185:        set name [string trim [string map {precip. precip current "" temperature temp visibility vis pressure pres humidity hum forecast fcast tempature temp " like " " "} [string tolower $name]]]
 186:        if {$name=="date"} { set date [string map {" " ""} [string tolower $value]]; continue }
 187: # We FINALLY have our valid values.
 188:        set WData(${date}.${name}) ${value}
 189:        if {[lsearch $dates $date]==-1} { lappend dates $date }
 190:     }
 191:   }
 192:   if {$dates==""} { return "${zip}: No data" }
 193:   foreach date $dates {
 194:     if {![info exists WData(${date}.temp)]} {
 195:       if {![info exists WData(${date}.high)]} { set WData(${date}.high) "" }
 196:       if {![info exists WData(${date}.low)]} { set WData(${date}.low) "" }
 197:       set WData(${date}.temp) "$WData(${date}.high)$WData(${date}.low)"
 198:     }
 199:     set WInfo($date) ""
 200:     foreach data {wind vis fcast temp hum {precip chance} {feels temp} {uv index}} {
 201:       if {[info exists WData(${date}.${data})]} {
 202:         append WData(${date}) "${data}: $WData(${date}.${data}) | "
 203:       }
 204:     }
 205:     set WData(${date}) [string range $WData(${date}) 0 end-3]
 206:   }
 207:   set udate [lindex $dates $DateNum]
 208:   return "${zip}: ${udate} $WData(${udate})"
 209: }
 210: 
 211: 
 212: 
 213: 
 214: proc dns {text} {
 215:   set text [string tolower $text]
 216:   set text [split $text]
 217: 
 218:   set qtype [lindex $text 0]
 219:   set host [lindex $text 1]
 220: 
 221:   if { $host == "" } {
 222:     set host $qtype
 223:     if {[regexp {^[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*$} $host]} { set qtype ptr } else { set qtype a }
 224:   }
 225: 
 226:   # verify record type
 227:   if { ![regexp -nocase "^a|aaaa|cname|hinfo|minfo|mx|ns|ptr|soa|txt|uinfo|wks$" $qtype] } {
 228:     return "dns: Invalid record type."
 229:   }
 230: 
 231:   # verify record-type
 232:   if { ![regexp -nocase "^\[a-z0-9.åäöü-\].*$" $host] } {
 233:     return "dns: Invalid hostname or ip address."
 234:   }
 235: 
 236:   # run the 'host' command
 237:   # if your host command is broken, try removing the -R and -W switch
 238:   catch { set res [exec host -t $qtype -- $host] } err
 239: 
 240:   if {![info exists res]} { set res "" }
 241:   if { $res == "" } {
 242:     return "dns: $host: No [string toupper $qtype] record found."
 243:   }
 244: 
 245:   set res [split $res \n]
 246:   for {set i 0} {$i<3 && [lindex $res $i]!=""} {incr i} {
 247:     lappend Ret [lindex [split [lindex $res $i]] end]
 248:   }
 249:   if {[llength $res]>3} { lappend Ret "..." }
 250:   if {[info exists Ret]} {
 251:     return "dns: $host\[$qtype\] -> [join $Ret {, }]"
 252:   }
 253:   return "dns: Error"
 254: }
 255: 
 256: 
 257: 
 258: proc findzip {text} {
 259: 	global STORE_zip
 260: 
 261: 	set text [split $text]
 262: 	set state [string toupper [lindex $text end]]
 263: 	set ocity [string map {, ""} [lrange $text 0 end-1]]
 264: 	set city [string map { \  %20 \" %22 & %26 + %2B , "" } $ocity]
 265: 
 266: 	if {$city=="" || $state==""} { return "findzip:  Need State and City" }
 267: 
 268: 	catch { set res [exec lynx -connect_timeout=2 -dump "http://yellow.whitepages.com/find_zip_code_results.pl?city=$city&state=$state&type=lookup_by_loc"] }
 269: 
 270: 	if {![info exists res]} { set res "" }
 271: 	if {$res==""} { return "findzip:  Could not find $city, $state" }
 272: 
 273: 	set res [split $res \n]
 274: 
 275: 	set Start 0
 276: 	foreach ln $res {
 277: 		set wrk [string tolower [split [string trim $ln]]]
 278: 		if {[lrange $wrk 0 2]=="zip codes for"} { set Start 1; continue }
 279: 		if {$Start && ![regexp {^[0-9]{5}$} [lindex $wrk 0]]} { set Start 0; break }
 280: 		if {$Start} { lappend Output [lindex $wrk 0] }
 281: 	}
 282: 	if {![info exists Output]} {
 283: 		return "findzip: No zip for $ocity, $state"
 284: 	}
 285: 	set tmpzip [lindex $Output 0]
 286: 	if {[regexp {^[0-9]{5}$} $tmpzip]} { set STORE_zip $tmpzip }
 287: 	return "findzip: $ocity, $state: [join $Output {, }]"
 288: }
 289: 
 290: proc reverse {text} {
 291: 	set args [split $text]
 292: 
 293: 	regsub -all {[^0-9]} $args {} args
 294: 	set phone [string range $args end-6 end]
 295: 	set area [string range $args end-9 end-7]
 296: 
 297: 	if {![regexp {^[0-9]{3}$} $area] || ![regexp {^[0-9]{7}$} $phone]} { return "reverse: Invalid phone number." }
 298: 
 299: 	catch { set res [exec lynx -width=200 -connect_timeout=2 -dump "http://yellow.whitepages.com/find_person_results.pl?f=&l=&c=&s=&ac=$area&p=$phone&s_n=&s_a=&fid="] }
 300: 
 301: 	if {![info exists res]} { set res "" }
 302: 	if {$res==""} { return "reverse: Error with request." }
 303: 	
 304: 	set res [split $res \n]
 305: 	set Start 0
 306: 	set Output ""
 307: 	foreach ln $res {
 308: 		if {$ln=="References"} { break }
 309: 		set ln [string trim $ln]
 310: 		if {[string match {*\[*\]*} $ln]} { continue }
 311: 		set wrk [split $ln]
 312: 		if {[string tolower [lrange $wrk 0 1]]=="search took"} { set Start 1; continue }
 313: 		if {[llength $wrk]==1 && [regexp {^[A-Z][a-z]*$} $wrk] || [lindex $wrk 0]=="»"} { continue }
 314: 		if {$Start && $ln!="" && [string first $ln $Output]==-1} { append Output "$ln | " }
 315: 	}
 316: 	if {[string trim $Output]!=""} {
 317: 		return "reverse: [string range $Output 0 end-3]"
 318: 	} else {
 319: 		return "reverse: Could not find ($area)$phone"
 320: 	}
 321: }
 322: 
 323: 
 324: 
 325: proc yp {text} {
 326: 	global STORE_zip
 327: 
 328: 	set text [split $text]
 329: 	set zip [string trim [lindex $text 0]]
 330: 	if {![regexp {^[0-9]{5}$} $zip]} {
 331: 		if {[info exists STORE_zip]} {
 332: 			set zip ${STORE_zip}
 333: 			set text "\{\} $text"
 334: 		} else {
 335: 			return "yp: Invalid zip code."
 336: 		}
 337: 	}
 338: 	set business [string trim [lrange $text 1 end]]
 339: 	set businessq [string map { \  %20 \" %22 & %26 + %2B } $business]
 340: 
 341: 	set STORE_zip $zip
 342: 	if {$business==""} { return "yp: Invalid business." }
 343: 
 344: 	catch { set res [exec lynx -width=200 -connect_timeout=2 -dump  "http://www.smartpages.com/directory/search.jhtml?sourceid=00394724864957215&pgtarg=ylwres&qvref=whtpgs&ClearLevel=Cloud9&QueryString=${businessq}&QueryType=2&CityZipAC=${zip}&State="] }
 345: 
 346: 	if {![info exists res]} { set res "" }
 347: 	if {$res==""} { return "yp: Error with request." }
 348: 
 349: 	set res [split $res \n]
 350: 
 351: 	set Start 0
 352: 	set ShowingCnt 0
 353: 	set Output ""
 354: 	foreach ln $res {
 355: 		if {$ln=="References" || $ShowingCnt==2} { break }
 356: 		set ln [string trim $ln]
 357: 		if {[string match "Results for * in ZIP code *" $ln]} { set Start 1; continue }
 358: 		if {!$Start} { continue }
 359: 		regsub {^\[[0-9]*\]} $ln {} ln
 360: 		if {[string match {*\[*\]*} $ln] || [string match {_________*} $ln]} { continue }
 361: 		if {[string match {(Showing *)} $ln]} { incr ShowingCnt; continue }
 362: 		if { $ln!="" && [string first $ln $Output]==-1} { append Output "$ln | " }
 363: 	}
 364: 	if {[string trim $Output]!=""} {
 365: 		return "yp: [string range $Output 0 end-3]"
 366: 	} else {
 367: 		return "yp: No matches found for $business in $zip"
 368: 	}
 369: }
 370: 
 371: 
 372: proc wp {text} {
 373: 	global STORE_zip
 374: 
 375: 	set text [split $text]
 376: 	set zip [string trim [lindex $text 0]]
 377: 	if {![regexp {^[0-9]{5}$} $zip]} {
 378: 		if {[info exists STORE_zip]} {
 379: 			set zip ${STORE_zip}
 380: 			set text "\{\} $text"
 381: 		} else {
 382: 			return "wp: Invalid zip code."
 383: 		}
 384: 	}
 385: 	set first [string trim [lindex $text 1]]
 386: 	set last [string trim [lindex $text end]]
 387: 
 388: 	set STORE_zip $zip
 389: 	if {$first=="" || $last=="" || [llength $text]==2} { return "wp: Invalid person." }
 390: 
 391: 	catch { set res [exec lynx -width=200 -connect_timeout=2 -dump "http://yellow.whitepages.com/find_person_results.pl?f=${first}&l=${last}&c=${zip}&s=&ac=&p=&s_n=&s_a=&fid="] }
 392: 
 393: 	if {![info exists res]} { set res "" }
 394: 	if {$res==""} { return "wp: Error processing request." }
 395: 
 396: 	set res [split $res \n]
 397: 	set Start 0
 398: 	set Output ""
 399: 	foreach ln $res {
 400: 		if {$ln=="References"} { break }
 401: 		set ln [string trim $ln]
 402: 		if {[string match {*\[*\]*} $ln]} { continue }
 403: 		set wrk [split $ln]
 404: 		if {[string tolower [lrange $wrk 0 1]]=="search took"} { set Start 1; continue }
 405: 		if {[llength $wrk]==1 && [regexp {^[A-Z][a-z]*$} $wrk] || [lindex $wrk 0]=="»"} { continue }
 406: 		if {$Start && $ln!="" && [string first $ln $Output]==-1} { append Output "$ln | " }
 407: 	}
 408: 	if {[string trim $Output]!=""} {
 409: 		return "wp: [string range $Output 0 end-3]"
 410: 	} else {
 411: 		return "wp: Could not find $first $last in $zip"
 412: 	}
 413: 	
 414: }
 415: 
 416: 
 417: 
 418: 
 419: proc ping {ip {num 5}} {
 420: 	catch { set res [exec ping -c $num $ip] } err
 421: 
 422: 	if {![info exists res]} { set res "$err" }
 423: 	foreach ln [split $res \n] {
 424: 		if {[string match "* packets transmitted*" $ln]} { lappend Output "[string trim [lindex [split $ln ,] end]]"  }
 425: 		if {[string match "round-trip * = *" $ln]} { lappend Output "[string trim [lindex [split $ln =] end]]"  }
 426: 	}
 427: 	if {![info exists Output]} {
 428: 		return "ping: Could not ping $ip"
 429: 	}
 430: 	return "ping: $ip\[$num\]: [join $Output ", "]"
 431: }
 432: 
 433: 
 434: 
 435: proc movies {text} {
 436: 	global STORE_movies
 437: 	set args [split $text]
 438: 
 439: 	if {[info exists STORE_movies]} { unset STORE_movies }
 440: 
 441: 	if {$args!=""} { set MShowAll 1 } else { set MShowAll 0 }
 442: 
 443: 	catch { set res [exec lynx -width=200 -connect_timeout=2 -dump "http://www.movie-info.com/ONeil/choctaw.htm"] }
 444: 
 445: 	if {![info exists res]} { set res "" }
 446: 	if {$res==""} { return "movies: Error processing request." }
 447: 
 448: 	lappend MDay1 [clock format [clock seconds] -format %a]
 449: 	if {[regexp {^(Sat|Sun)$} ${MDay1}]} { lappend MDay2 WEnd } else { lappend MDay2 WDay }
 450: 
 451: 	set Cnt 0
 452: 	set Start 0
 453: 	foreach ln [split $res \n] {
 454: 		set ln [string trim $ln]
 455: 		if {$ln=="References" || [string match -nocase "Coming*Soon" $ln]} { break }
 456: 		if {[string match "NOW SHOWING *" $ln]} { lappend Output "[string map -nocase {NOVEMBER Nov DECEMBER Dec JANUARY Jan FEBRUARY Feb MARCH Mar APRIL Apr MAY May JUNE Jun JULY Jul AUGUST Aug SEPTEMBER Sept OCTOBER Oct} [lrange $ln 3 end]]"; set Start 1; continue }
 457: 		if {!$Start} { continue }
 458: 		regsub -all {^hi there \[[0-9]*\]} $ln "" ln
 459: 		if {[regexp {^[A-Z][a-z][a-z] - [A-Z][a-z][a-z] } $ln]} {
 460: 			set ln [split $ln]
 461: 			set MDates [string map -nocase {"Mon - Fri" "WDay" "Sat - Sun" "WEnd"} [join [lrange $ln 0 2]]]
 462: 			if {!$MShowAll} {
 463: 				if {![string match "*${MDay1}*" $MDates] && ![string match "*${MDay2}*" $MDates]} { continue }
 464: 			}
 465: 			set MTimes ""
 466: 			foreach pt [lrange $ln 3 end] {
 467: 				set pt [string trim $pt]
 468: 				if {$pt!=""} { lappend MTimes $pt }
 469: 			}
 470: 			lappend TmpOutput $MDates
 471: 			if {$MTimes!=""} { lappend TmpOutput [join $MTimes] }
 472: 		}
 473: 		if {[regexp {[0-9] *minutes$} $ln]} {
 474: 			if {[info exists TmpOutput]} {
 475: 				lappend Output [join $TmpOutput {, }]
 476: 				set TmpOutput ""
 477: 			}
 478: 			set tmp [split $ln]
 479: 			set ln ""
 480: 			foreach pt $tmp { if {$pt!=""} { lappend ln $pt } }
 481: 			set MName [join [lrange $ln 0 end-3]]
 482: 			set MRating [lindex $ln end-2]
 483: 			set MLength "[lindex $ln end-1] min"
 484: 			lappend TmpOutput "$MName" "$MRating" "$MLength"
 485: 			set STORE_movies($Cnt) "$MName"
 486: 			incr Cnt
 487: 		}
 488: 	}
 489: 	if {[info exists TmpOutput]} {
 490: 		if {$TmpOutput!=""} {
 491: 			lappend Output [join $TmpOutput {, }]
 492: 		}
 493: 	}
 494: 	if {[info exists Output]} {
 495: 		return "movies: [join $Output { | }]"
 496: 	} else {
 497: 		return "movies: Could not find any movies."
 498: 	}
 499: 
 500: }
 501: 
 502: 
 503: #proc unknown args { }
 504: #proc alias args { }
 505: 
 506: 
 507: proc ed {text} {
 508: 	global STORE_ed
 509: 
 510: 	set args [split $text]
 511: 	set cmd [lindex $args 0]
 512: 	set data [join [lrange $args 1 end]]
 513: 	if {[regexp {^[0-9]} $cmd]} {
 514: 		regsub {[^0-9].*} $cmd {} repeat
 515: 		regsub {^[0-9]*} $cmd {} cmd
 516: 	} else {
 517: 		set repeat 1
 518: 	}
 519: 	switch -- $cmd {
 520: 		"q!!" { unset STORE_ed }
 521: 		"q!" {
 522: 			if {[info exists STORE_ed(tmp)]} { file delete $STORE_ed(tmp) }
 523: 			unset STORE_ed
 524: 		}
 525: 		"o" {
 526: 			if {[info exists STORE_ed(tmp)]} { return "ed: A file is already open." }
 527: 			random seed [clock seconds]
 528: 			set STORE_ed(tmp) "/var/tmp/ced_[random 99999]"
 529: 			if {$data!=""} {
 530: 				set STORE_ed(fn) [lindex $data 0]
 531: 				catch { file copy -force $STORE_ed(fn) $STORE_ed(tmp) }
 532: 			}
 533: 			catch { set tmpId [open $STORE_ed(tmp) "RDWR CREAT"] }
 534: 			if {![info exists tmpId]} { if {[info exists STORE_ed(fn)]} { unset STORE_ed(fn) }; unset STORE_ed(tmp); return "ed: Could not open temporary file." }
 535: 			gets $tmpId STORE_ed(linebuf)
 536: 			close $tmpId
 537: 			set STORE_ed(line) 1
 538: 			set STORE_ed(fphint) 1
 539: 		}
 540: 		"i" {
 541: 			if {![info exists STORE_ed(linebuf)]} { return "ed: You must open a file." }
 542: 			set STORE_ed(linebuf) "[replicate [join $data] $repeat]$STORE_ed(linebuf)"
 543: 		}
 544: 		"a" {
 545: 			if {![info exists STORE_ed(linebuf)]} { return "ed: You must open a file." }
 546: 			set STORE_ed(linebuf) "$STORE_ed(linebuf)[replicate [join $data] $repeat]"
 547: 		}
 548: 		"l" {
 549: 			if {![info exists STORE_ed(linebuf)]} { return "ed: You must open a file." }
 550: 			return "ed: $STORE_ed(line): $STORE_ed(linebuf)"
 551: 		}
 552: 		"s" {
 553: 			if {![info exists STORE_ed(linebuf)]} { return "ed: You must open a file." }
 554: 			
 555: 			regsub 
 556: 		}
 557: 	}
 558: 	return ""
 559: }
 560: 
 561: 
 562: 
 563: 
 564: proc note {text} {
 565: 	global STORE_notes STORE_notes_search STORE_notes_search_off
 566: 
 567: 	set wrk [split [string trim $text]]
 568: 	set cmd [lindex $wrk 0]
 569: 	set data [join [lrange $wrk 1 end]]
 570: 	if {[string index $cmd 0]=="-"} {
 571: 		switch -- $cmd {
 572: 			"-f" {
 573: 				if {[info exists STORE_notes_search]} {
 574: 					if {${STORE_notes_search}!=$data} {
 575: 						set STORE_notes_search $data
 576: 						set STORE_notes_search_off -1
 577: 					}
 578: 				} else {
 579: 					set STORE_notes_search $data
 580: 					set STORE_notes_search_off -1
 581: 				}
 582: 				foreach nt [lsort -integer [array names STORE_notes]] {
 583: 					if {$nt<=$STORE_notes_search_off} { continue }
 584: 					if {[regexp $data $STORE_notes($nt)]} {
 585: 						set STORE_notes_search_off $nt
 586: 						return "$nt: $STORE_notes($nt)"
 587: 					}
 588: 				}
 589: 				unset STORE_notes_search
 590: 				return "note: No note found."
 591: 			}
 592: 			"-g" {
 593: 				if {$data=="" && [info exists STORE_notes_search_off]} {
 594: 					set data $STORE_notes_search_off
 595: 				}
 596: 				if {![info exists STORE_notes($data)]} {
 597: 					return "note: No such note ($data)"
 598: 				} else {
 599: 					return "$STORE_notes($data)"
 600: 				}
 601: 			}
 602: 			"-d" {
 603: 				if {$data=="" && [info exists STORE_notes_search_off]} {
 604: 					set data $STORE_notes_search_off
 605: 				}
 606: 				if {![info exists STORE_notes($data)]} {
 607: 					return "note: No such note ($data)"
 608: 				} else {
 609: 					unset STORE_notes($data)
 610: 				}
 611: 			}
 612: 		}
 613: 		return ""
 614: 	}
 615: 
 616: 	if {[array exists STORE_notes]} {
 617: 		catch { set idx [expr [lindex [lsort -integer [array names STORE_notes]] end]+1] }
 618: 		if {![info exists idx]} { set idx 0 }
 619: 	} else {
 620: 		set idx 0
 621: 	}
 622: 	set STORE_notes($idx) $text
 623: 	return ""
 624: }
 625: 
 626: 
 627: 
 628: proc irc {text} {
 629: 	global STORE_irc
 630: 
 631: 	if {[info exists STORE_irc(sock)]} {
 632: 		if {[file exists $STORE_irc(sock)] && $STORE_irc(sock)!=""} {
 633: 			if {[file type $STORE_irc(sock)]=="fifo"} {
 634: 				set CmdSock $STORE_irc(sock)
 635: 			}
 636: 		}
 637: 	}
 638: 
 639: 	if {[info exists CmdSock]} {
 640: 		catch { set fd [open $CmdSock WRONLY] }
 641: 		if {![info exists fd]} { unset CmdSock }
 642: 	}
 643: 	if {![info exists CmdSock]} {
 644: 		if {![info exists STORE_irc(nick)] && [lindex $text 0]!=""} {
 645: 			set STORE_irc(nick) [lindex $text 0]
 646: 			set Ret 1
 647: 		}
 648: 		if {![info exists STORE_irc(server)] && [lindex $text 1]!=""} {
 649: 			set STORE_irc(server) [lindex $text 1]
 650: 			set Ret 1
 651: 		}
 652: 		if {[info exists STORE_irc(nick)] && [info exists STORE_irc(server)]} {
 653: 			set sock [irc_client $STORE_irc(nick) $STORE_irc(server)]
 654: 			if {$sock==""} { return "irc: Could not start client." }
 655: 			set STORE_irc(sock) $sock
 656: 			set CmdSock $sock
 657: 			sleep 1
 658: 			catch { set fd [open $CmdSock r] }
 659: 			if {![info exists fd]} { return "irc: Could not connect to client." }
 660: 			gets $fd STORE_irc(pid)
 661: 			close $fd
 662: 			unset fd
 663: 			if {$STORE_irc(pid)==""} { return "irc: Could not connect to client." }
 664: 			catch { set fd [open $CmdSock w] }
 665: 			if {![info exists fd]} { return "irc: Could not connect to client." }
 666: 			if {[info exists Ret]} { return "irc: Connected." }
 667: 		} else {
 668: 			return "irc: Please specify nick and server. args=$text"
 669: 		}
 670: 	}
 671: 
 672: 	puts $fd "$text"
 673: 	close $fd
 674: 	kill SIGIO $STORE_irc(pid)
 675: }
 676: 
 677: proc irc_client {nicksug server {chans ""}} {
 678: 	global CmdAddr CmdRespLen CmdSock IRC
 679: 	set IRC(nick) $nicksug
 680: 
 681: 	set Fifo "/"
 682: 	while {[file exists $Fifo]} { set Fifo "/tmp/irc-commander[clock seconds][clock clicks]" }
 683: 
 684: 	catch { exec /bin/mknod $Fifo p }
 685: 	if {![file exists $Fifo]} {
 686: 		return ""
 687: 	} else {
 688: 		if {[file type $Fifo]!="fifo"} { return "" }
 689: 	}
 690: 
 691: 	set childpid [fork]
 692: 	if {$childpid!=0} { wait $childpid; return $Fifo }
 693: 
 694: 	set grandchildpid [fork]
 695: 	if {$grandchildpid!=0} { exit }
 696: 
 697: 	signal trap SIGIO {
 698: 		global IRC
 699: 		if {![info exists CmdSock]} { return }
 700: 		if {$CmdSock==""} { return }
 701: 		set IRC(cmd) "Data"
 702: 	}
 703: 	signal trap SIGALRM {
 704: 		global IRC
 705: 		alarm 60
 706: 		set SendMsg ""
 707: 		if {[info exists IRC(msg)]} {
 708: 			foreach msg $IRC(msg) {
 709: 				if {[string tolower [lindex $msg 1]]==[string tolower $IRC(nick)]} {
 710: 					set msgf "[lindex $msg 0](p)"
 711: 				} else {
 712: 					set msgf "[lindex $msg 0]"
 713: 				}
 714: 				append SendMsg "$msgf> [lindex $msg 2] | "
 715: 			}
 716: 			SendEmailReply [string range $SendMsg 0 end-3] "irc"
 717: 		}
 718: 		set IRC(msg) ""
 719: 	}
 720: 	alarm 60
 721: 	set CmdSock [open $Fifo WRONLY]
 722: 	puts $CmdSock "[pid]"
 723: 	close $CmdSock
 724: 	set CmdSock [open $Fifo r]
 725: 	fconfigure $CmdSock -blocking no
 726: 	catch { set IRC(sock) [socket $server 6667] }
 727: 	if {![info exists IRC(sock)]} {
 728: 		file delete $Fifo
 729: 		exit
 730: 	}
 731: 	fileevent $IRC(sock) readable {
 732: 		gets $IRC(sock) ln
 733: 		if {[eof $IRC(sock)]} { unset IRC(sock); return }
 734: 		lappend IRC(data) $ln
 735: 	}
 736: 	puts $IRC(sock) "NICK $IRC(nick)"
 737: 	flush $IRC(sock)
 738: 	puts $IRC(sock) "USER $IRC(nick) +iw $IRC(nick) :IRC over email client"
 739: 	flush $IRC(sock)
 740: 
 741: 	set IRC(cmd) ""
 742: 	set IRC(data) ""
 743: 	set IRC(msg) ""
 744: 	set IRC(connected) 0
 745: 	set IRC(cmdlist) ""
 746: 	set Terminate 0
 747: 	irc_sustain_loop
 748: 	while 1 {
 749: 		vwait IRC
 750: 		if {![info exists IRC(sock)]} { break }
 751: 		while 1 {
 752: 			set data ""
 753: 			if {[string trim [join $IRC(cmdlist)]]!="" && $IRC(connected)} {
 754: 				set data [lindex $IRC(cmdlist) 0]
 755: 				set IRC(cmdlist) [lrange $IRC(cmdlist) 1 end]
 756: 			}
 757: 			if {$data==""} { gets $CmdSock data }
 758: 			if {$data==""} { break }
 759: 			if {!$IRC(connected)} {
 760: 				lappend IRC(cmdlist) $data
 761: 				continue
 762: 			}
 763: 			if {[string index $data 0]=="/"} {
 764: 				set wrk [split $data]
 765: 				set Cmd [string range [lindex $wrk 0] 1 end]
 766: 				set Args [join [lrange $wrk 1 end]]
 767: 				switch -- $Cmd {
 768: 					"quit" { set Terminate 1; break }
 769: 					"j" {
 770: 						if {[string index $Args 0]!="#"} { set Args "#$Args" }
 771: 						puts $IRC(sock) "JOIN $Args"
 772: 						flush $IRC(sock)
 773: 						set IRC(defdest) $Args
 774: 					}
 775: 					"m" {
 776: 						set wrk [split $Args]
 777: 						set dest [lindex $wrk 0]
 778: 						set msg [join [lrange $wrk 1 end]]
 779: 						puts $IRC(sock) "PRIVMSG $dest :$msg"
 780: 						flush $IRC(sock)
 781: 					}
 782: 					"q" {
 783: 						set wrk [split $Args]
 784: 						set IRC(defdest) [lindex $wrk 0]
 785: 						set msg [join [lrange $wrk 1 end]]
 786: 						puts $IRC(sock) "PRIVMSG $IRC(defdest) :$msg"
 787: 						flush $IRC(sock)
 788: 					}
 789: 					"p" {
 790: 						if {[string index $Args 0]!="#"} { set Args "#$Args" }
 791: 						puts $IRC(sock) "PART $Args"
 792: 						flush $IRC(sock)
 793: 					}
 794: 				}
 795: 			} else {
 796: 				if {[info exists IRC(defdest)]} {
 797: 					puts $IRC(sock) "PRIVMSG $IRC(defdest) :$data"
 798: 					flush $IRC(sock)
 799: 				}
 800: 			}
 801: 		}
 802: 		foreach ln $IRC(data) {
 803: 			if {[string range $ln 0 4]=="PING "} {
 804: 				puts $IRC(sock) "PONG [string range $ln 5 end]"
 805: 				flush $IRC(sock)
 806: 			}
 807: 			if {[string index $ln 0]==":"} {
 808: 				set wrk [split [string range $ln 1 end]]
 809: 				set Msg [string range $ln [expr [string first ":" $ln 1]+1] end]
 810: 				set Src [lindex $wrk 0]
 811: 				set Op [lindex $wrk 1]
 812: 				set Dest [lindex $wrk 2]
 813: 				switch -- $Op {
 814: 					"001" {
 815: 						set IRC(connected) 1
 816: 						SendEmailReply "irc: Online."
 817: 					}
 818: 					"432" {
 819: 						set IRC(nick) "IRC[clock seconds]"
 820: 						puts $IRC(sock) "NICK $IRC(nick)"
 821: 						flush $IRC(sock)
 822: 					}
 823: 					"433" {
 824: 						if {$Dest=="*"} {
 825: 							set IRC(nick) "$IRC(nick)_"
 826: 							puts $IRC(sock) "NICK $IRC(nick)"
 827: 							flush $IRC(sock)
 828: 						} else {
 829: 							set IRC(nick) $Dest
 830: 						}
 831: 					}
 832: 					"PRIVMSG" {
 833: 						set SrcNick [string range $Src 0 [expr [string first "!" $Src]-1]]
 834: 						if {[string index $Msg 0]=="\001"} {
 835: 							set Msg [string range $Msg 1 end-1]
 836: 							set wrk [split $Msg]
 837: 							set CTCP [string toupper [lindex $wrk 0]]
 838: 							set Args [join [lrange $wrk 1 end]]
 839: 							switch -- $CTCP {
 840: 								"PING" {
 841: 									puts $IRC(sock) "NOTICE $SrcNick :\001PING $Args\001"
 842: 									flush $IRC(sock)
 843: 								}
 844: 								"VERSION" {
 845: 									puts $IRC(sock) "NOTICE $SrcNick :\001VERSION IRC-over-email client.\001"
 846: 									flush $IRC(sock)
 847: 								}
 848: 							}
 849: 							continue
 850: 						} 
 851: 						lappend IRC(msg) [list $SrcNick $Dest $Msg]
 852: 					}
 853: 				}
 854: 			}
 855: 		}	
 856: 
 857: 		set SendMsg ""
 858: 		foreach msg $IRC(msg) {
 859: 			if {[string tolower [lindex $msg 1]]==[string tolower $IRC(nick)]} {
 860: 				set msgf "[lindex $msg 0](p)"
 861: 			} else {
 862: 				set msgf "[lindex $msg 0]"
 863: 			}
 864: 			append SendMsg "$msgf> [lindex $msg 2] | "
 865: 		}
 866: 		if {[string length $SendMsg]>=[expr $CmdRespLen/2]} {
 867: 			SendEmailReply [string range $SendMsg 0 end-3] "irc"
 868: 			set IRC(msg) ""
 869: 		}
 870: 
 871: 		if {$Terminate} { break }
 872: 		set IRC(data) ""
 873: 	}
 874: 	SendEmailReply "Terminating nick=$IRC(nick), server=$server"
 875: 	file delete $Fifo
 876: 	exit
 877: }
 878: proc irc_sustain_loop args { after 2147483647 { irc_sustain_loop } }
5749373 [rkeene@sledge /home/rkeene/projects/commander/_commander]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2002-11-19 23:19:47