InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/tcl/expect/scripts/alpha-pager

Text File | 1993-07-05 | 6.5 KB | 306 lines

#!/local/bin/expect
#From cme!dove!uunet!haven.umd.edu!cville-srv.wam.umd.edu!ni.umd.edu!sayshell.umd.edu!louie Mon Jul  5 19:40:50 EDT 1993
#Article: 12626 of comp.unix.bsd
#Path: cme!dove!uunet!haven.umd.edu!cville-srv.wam.umd.edu!ni.umd.edu!sayshell.umd.edu!louie
#From: [e-mail] (Louis A. Mamakos)
#Newsgroups: comp.unix.bsd
#Subject: Re: BSDI and IXO
#Message-ID: <21486h$[e-mail]>
#Date: 3 Jul 93 15:21:53 GMT
#References: <20sp7v$[e-mail]>
#Organization: University of Maryland, College Park
#Lines: 290
#NNTP-Posting-Host: sayshell.umd.edu
#
#In article <20sp7v$[e-mail]> [e-mail] (Brian Cartmell) writes:
#>Does anyone have a program that works on BSD that will connect to a device
#>dial a number and transfer Alpha Pager Message via the IXO for alpha pagers?
#
#I have an expect script (actually, two files) that does this.  It can
#use tip(1) to actually talk to the modem.  We also have a different
#module that telnets to an terminal server with dial-out modems too,
#that just uses a different "hardware" file.
#
#This pretty ugly and disgusting, but the implementation of the IXO
#protocol in TCL, I thought, was rather interesting.
#
#It's usually invoked as
#
#    beep pagerid "It's broken!  Help!"  pagerid2 "Help! It's down!"
#
#there's also a way to pass it a file containing pagerids and messages for
#"bulk" beeping.
#
#Louis Mamakos
#
#
#!/local/bin/expect
#
#  Call a beeper.  By default, uses tip(1c) to establish the modem connection
#  which requires an entry in /etc/remote that looks like this:
#
#    dialer:dv=/dev/cufa:br#38400:pa=even:
#

log_user 0
#debug 1

# definition of paging service's phone number
set service "474-4657"
# hardware to use
set hardware beep.tip

# definitions of various ascii control characters used by the paging
# protocol

set STX \002
set ETX \003
set ACK \006
set NAK \025
set RS  \036
set ESC \033
set EOT \004


# ===

proc error { msg } {
    puts stderr "Error: $msg"
    exit
}

# ===

#
#  compute the checksum over the paging transaction packet.  Return the
#  checksum string
#
proc checksum { s } {
    set sum 0
    foreach ch [split $s {}] {
        scan $ch "%c" v
        incr sum $v
    }
    return [format "%c%c%c" [expr "48 + (($sum >> 8) & 15)"] \
                [expr "48 + (($sum >> 4) & 15)"] \
                [expr "48 + ($sum & 15)"]];
}

# ===

proc get_response {} {
    global ACK NAK RS ESC EOT

    expect    "*$ACK\r"     {puts stderr "resp: OK";  return "OK"} \
        "*$NAK\r"     {puts stderr "resp: NAK"; return "NAK"} \
        "*$RS\r"      {puts stderr "resp: ABANDON"; return "ABANDON"} \
        "*$ESC$EOT\r" {puts stderr "resp: DISC"; return "DISC"} \
        timeout          {puts stderr "resp: TIMEOUT"; return "TIMEOUT"}
}

# ===

#
#  Generate a page to "pin" carrying the message "message"
#
proc page { pin message } {
    global STX ETX

    set attempts 0

    regsub "\t+" $message " " message
    set message [string range $message 0 238]

    set pgstr "${STX}${pin}\r${message}\r${ETX}"
    set block "$pgstr[checksum $pgstr]\r"

    send $block
    puts stderr "Sending page to $pin"
    set resp [get_response]
    #
    #  Examine the response.  Only "NAK" responses are retried
    #
    while {! [string compare "NAK" $resp] && $attempts < 5} {
        puts stderr "Resending block due to NAK"
        exec sleep 1
        send $block
        set resp [get_response]
        incr attempts
    }
    return $resp
}

# ===

#
#  condition the paging system to accept the Paging Entry Terminal protocol,
#  rather than thinking we're a dumb terminal out here.
#
proc dologin {} {
   global ESC

   foreach i {once} {
    set timeout 5
    expect {*ID=} break    timeout {}
    set timeout 2
    send "\r"
    expect {*ID=} break    timeout {}
    send "\r"
    expect {*ID=} break    timeout {}
    send "\r"
    expect "*ID=" break    timeout {}
    send "\r"
    expect "*ID=" break    timeout {
        send_user "Error: waiting for id= prompt\r"
        return -1
    }
   }

   set timeout 10

   # this is the magic bit..
   send "${ESC}PG1000000\r"

   case [set resp [get_response]] in {
    OK    {puts stderr "Logged into paging service"}
    NAK   {error "to send of PG1"}
    TIMEOUT {error "timeout of response to PG1"}
    *    {error "Unexpected response '$resp' during login"}
   }
   return 0
}

# ===

proc logout {} {

    global EOT

    send "$EOT\r"
    case [get_response] in {
        DISC    {puts stderr "Normal disconnect"}
        RS    {puts stderr "Some pages may have failed"}
    }
}

# ============= start of main program =============


set argc [llength $argv]
set dofile 0

set arg 1

if {$argc>2 && ([string compare FILES [lindex $argv 1]] == 0)} {
    set dofile 1
    set arg 2
} else {
   if {$argc < 3} {
    puts stderr \
               "usage: [lindex $argv 0] pagerid message \[pagerid message ...\]"
    exit
    }
}

source $hardware

set success 0
for {set tries 5} {$tries} {set tries [expr $tries-1]} {
    # invoke communication facility specific function to establish
    # a connection with the paging service
    connect $service

    # attempt to initiate session protocol
    if {[dologin] == 0} {
        set success 1
        break
    }
}
if { $success == 0 } {
    error "Gave up looking for a working modem at the other end"
}

while {!$dofile && ($arg < $argc)} {
    set who [lindex $argv $arg]
    set msg [string range [lindex $argv [expr $arg+1]] 0 238]
    set arg [expr $arg+2]

    puts stderr "Paging $who with $msg"
    page $who "$msg"
}

if {$dofile} {
   while {$arg < $argc} {
    set dofile [open [set filename [lindex $argv $arg]] r]
    incr arg

    if {[gets $dofile who] < 0} {
        puts stderr "EOF reading recpient from $filename"
        exec rm -f $filename
        continue
    }

    if {[gets $dofile msg] < 0} {
        puts stderr "EOF reading message from $filename"
        exec rm -f $filename
        continue
    }

    if {[regsub "^ID=" $who "" who] == 0} {
        puts stderr "$filename: Missing ID= on pager line"
        exec rm -f $filename
        continue
    }
    if {[regsub "^MSG=" $msg "" msg] == 0} {
        puts stderr  "$filename: Missing ID= on pager line"
        exec rm -f $filename
        continue
    }
    close $dofile
    puts stderr "Paging $who with $msg"
    if {[page $who "$msg"] == "OK"} {
        exec rm -f $filename
    }
   }
}

# end session protocol
logout

#
# invoke communication facility specific function to disconnect from
# paging service
#
disconnect "Mission sucessful\n"
exit 0


----------- beep.tip

proc connect { pagerservice } {
   global spawn_id pid

   uplevel 1 set pid [spawn tip dialer]

   expect "connected*"

   send "AT\r"
   expect "*OK*" {}

   send "ATE0\r"
   expect "*OK*" {}

   send "ATM0&N15&K0DT${pagerservice}\r"
   set timeout 20
   expect "*CONNECT*\r" {}  timeout {error "modem didn't return CONNECT"}
   expect_after     eof    {error "Got EOF (default)"} \
        {\rNO\ CARRIER\r} {error "Lost connection"}
}

proc disconnect { msg } {
    send "\r~.\r"
    send_user $msg
}