#!/afs/athena/contrib/perl/perl

$verbose = 1;

sub fixterm {
    system("stty cooked");
    exit(0);
}

%errorcode =
    (
     "0000","None",
     "0001","Command line too long",
     "0002","Invalid command; prefix or letter not recognized",
     "0003","Invalid command suffix",
     "0004","Invalid command values (after =)",

     "0005","Did not find expected =",
     "0006","Command aborted by computer",
     "0007","Incorrect command format",
     "0010","No number in dial string",
     "1001","Line not provisioned for requested feature",

     "2000","No additional information",
     "2101","The X.25 link not available to execute command",
     "2199","The Q.931 link not available to execute command",
     "3000","Incorrect call ID; not in use",
     "3003","The command is inconsistent with the current state of the call",

     "3004","Invalid DN or dial string field",
     "3005",("The call ID is not for an active call; the hold, drop, ".
	     "transfer, or conference request cannot be honored"),
     "3006","The specified is not a voice call",
     "3007",("The reconnect command cannot be executed because the call ".
	     "is not on hold"),
     "3008","The previous request has not been completed",

     "3009","Cannot answer or connect call because another is already active",
     "3010","The second specified call is not on hold",
     "3999",("Cannot set Application Programming Interface switch.  DTR ".
	     "option must be set to \"follow\" (&D > 0)"),
     );

sub unparseisdn {
    local($line) = @_;

    $line =~ /^([^:]+):/;

    $key = $1;
    $args = $';
    @args = split(/,/,$args);

    if (defined($simple{$key})) {
	&SIMPLE($line,$key,@args);
    } elsif (defined(&$key)) {
	&$key($line,$key,@args);
    } else {
	print ";;",$line,"\n";
    }
}

sub myfgets {
    local($fh) = @_;
    local($new);

    while ($buf{$fh} !~ s/^(.*)\n//) {
	sysread($fh,$new,1024);
	$buf{$fh} .= $new;
    }

    return($1);
}

sub cmd {
    local($txt) = @_;

    print PORT $txt,"\n";
    print ">>> ",$txt,"\n" if $verbose;
    &myfgets("PORT");		# echo
    while (1) {
	$resp = &myfgets("PORT");
	print "<<< ",$resp,"\n" if $verbose;
	if ($resp eq "ERROR") {
	    print PORT "ATS88?\n";
	    print ">>>>>> ATS88?\n" if $verbose;
	    &myfgets("PORT");	# echo
	    $resp = &myfgets("PORT");
	    print "<<<<<< ",$resp,"\n" if $verbose;
	    $resp = ($errorcode{$resp} || $resp);
	    print "cmd \"$txt\" failed: $resp\n";
	    &myfgets("PORT");	# blank line
	    &myfgets("PORT");	# OK
	    last;
	} elsif ($resp eq "") {
	    # do nothing
	} elsif ($resp ne "OK") {
	    # Assume it's response from an ISDN query
	    &unparseisdn($resp);
	} else {
	    last;
	}
    }
}

%causecode =
    (
     "01","Unassigned or unallocated number",
     "02","No route to specified network",
     "08","Call is proceeding at destination interface",
     "10","Normal, Clearing",
     "11","User busy",

     "12","No user responding",
     "13","No answer from user",
     "15","Call rejected",
     "16","Number changed",
     "1B","Destination out of order",

     "1C","Invalid number format (incomplete number)",
     "1D","Requested facility rejected",
     "1E","Response to STATUS_ENQuiry",
     "1F","Normal unspecified",
     "22","No channel available",

     "23","Call queued",
     "26","Network out of order",
     "29","Temporary failure",
     "2A","Network congestion",
     "2B","Access information discarded",

     "2C","User information discarded",
     "2F","Resources unavailable, unspecified",
     "32","Requested facility not subscribed",
     "33","Bearer capability incompatible with service request",
     "34","Outgoing call barred",

     "35","Service operation violation",
     "36","Incoming calls barred",
     "39","Bearer capability not authorized",
     "3E","Bearer capability not presently available",
     "3F","Service or option not available",
     );

## function will be called with string in arg 0, name in arg 1,
## comma-separated fields in remaining args

%simple =
    (
     "CALL","call originated locally",
     "CONNECTED","voice connection established",
     "DELIVERED","ringing at remote end",
     "PROCEEDING","enough digits received; routing is proceeding",
     "PROMPT","additional digits needed to complete call",
     "RING","incoming voice call",
     );

sub SIMPLE {
    print "ID ",$_[2],": ",$simple{$_[1]},"\n";
}

%assoc =
    (
     "05","Setup:           Another phone is originating call",
     "07","Connect:         Another phone has connected to call",
     "08","Hold:            Another phone has placed call on hold",
     "0C","Reconnect:       Another phone has reconnected to call on hold",
     "0D","Exclusion:       Another phone has requested exclusive use",
     "0E","Connect Denied:  Another phone has exclusive use of this call",
     "0F","Clearing Denied: Another phone is still connected to this call",
     );

sub ASSOCIATED {
    print "ID ",$_[2],": ",$assoc{$_[3]},"\n";
}

sub BUFFER {
    print "Buffer overrun: some data has been lost\n";
}

sub BUSY {
    print "ID ",$_[2]," busy: ",$causecode{$_[3]},"\n";
}

%netloc =
    (
     "0","User",
     "1","Private network serving the local user",
     "2","Public network serving the local user",
     "3","Transit network",
     "4","Public network serving the remote user",
     "5","Remove private network",
     "7","International network",
     "A","Network beyond interworking point",
     );

sub CAUSE {
    print ("ID ",$_[2],": additional cause info: ",$causecode{$_[3]},"\n",
	   " " x (length($_[2])+10), "network location: ",$netloc{$_[4]},"\n");
}

sub CLEARED {
    print "ID ",$_[2]," cleared: ",$causecode{$_[3]},"\n";
}

%creq =
    (
     "00","placed on hold pending conference or transfer",
     "01","reconnected",
     "02","added to conference",
     "03","dropped",
     "04","transferred",
     );

sub COMPLETED {
    if ($_[3] eq "02") {
	print "ID ",$_[2]," added to conference ",$_[4],"\n";
    } else {
	print "ID ",$_[2]," ",$creq{$_[3]},"\n";
    }
}

%disp =
    (
     "01","Call appearance ID",
     "02","Called party number",
     "03","Calling party number",
     "04","Called party name",
     "05","Calling party name",

     "06","Originating permissions",
     "07","ISDN Call ID",
     "08","Misc call information",
     "09","Entire display",
     "0A","Date and Time of Day",

     "0B","Redirecting party number",
     "0C","Redirecting party name",
     "0D","Redirected party number",
     "0E","Redirected party name",
     "0F","Connected party number",
     );

sub DISPLAY {
    $_[3] =~ /^../;

    print "ID ",$_[2],": ",$disp{$&},": ",$',"\n";
}

%fstatus =
    (
     "00","Feature active (steady on)",
     "01","Feature inactive (steady off)",
     "02","Feature pending (steady flash)",
     "03","Local hold (steady flutter)",
     "04","Remote hold (steady wink)",
     "05","Feature request confirmed (3 sec on, then off)",
     "06","Feature in requested state (3 sec wink, return to prev)",
     "07","Feature request rejected (3 sec broken flutter, return to prev)",
     );     

sub FEATURE {
    print "ID ",$_[2],", button ",$_[3],": ",$fstatus{$_[4]},"\n";
}

sub HI {
    local($str) = @_;

    $str =~ s/^HI://;

    print "Human Interface: ",$str,"\n";
}

sub KEYPAD {
    if ($_[3] eq "00") {
	print "Keypad in use by a feature\n";
    } elsif ($_[2] eq "00") {
	print "Keypad available\n";
    } else {
	print "ID ",$_[2],": Keypad usable for call\n";
    }
}

%mode =
    (
     "0","No change",
     "1","Normal",
     "2","Inspect",
     "3","Misc display info",
     "4","Message retrieval",
     "5","Electronic directory query",
     );

%submode =
    (
     "0","No",
     "1","Direct",
     "2","Redirected",
     );

sub MODE {
    print "ID ",$_[2],": Display mode: ",$mode{$_[3]};
    print ", ",$submode{$_[3]}," submode" if $_[3];
    print "\n";
}

%partytype =
    (
     "1","Called",
     "2","Calling",
     "3","Connected",
     );

%numtype =
    (
     "0","Unknown type",
     "1","International number",
     "2","National number",
     "3","Network specific number",
     "4","Subscriber/local (directory) number",
     "6","Abbreviated number",
     "7","Type reserved for extension",
     );

%numplan =
    (
     "0","Unknown plan",
     "1","ISDN/Telephony numbering plan",
     "3","Data numbering plan",
     "4","Telex numbering plan",
     "8","National Standard numbering plan",
     "9","Private numbering plan",
     "F","Plan reserved for extension",
     );

%present =
    (
     "0","Presentation allowed",
     "1","Presentation restricted",
     "2","Number not available due to interworking",
     "3","Spare/Reserved",
     );

%screening =
    (
     "0","User provided - Not network screened",
     "1","User provided - Verified and passed",
     "2","User provided - Verified and failed",
     "3","Network provided",
     );

sub PARTY {
    if (@_ == 7) {
	print("ID ",$_[2]," ",$partytype{$_[3]}," party: ",$_[6]," (",
	      $numtype{$_[4]},", ",$numplan{$_[5]},")\n");
    } else {
	print("ID ",$_[2]," ",$partytype{$_[3]}," party: ",$_[8]," (",
	      $numtype{$_[4]},", ",$numplan{$_[5]},", ",
	      $present{$_[6]},", number is ",$screening{$_[7]},")\n");
    }
}

%pdesc =
    (
     "01","Call is not end-to-end ISDN, further info may be available in-band",
     "02","Destination call address is not ISDN",
     "03","Origination call address is not ISDN",
     "04","Call has returned to the ISDN",
     "08","In-band treatment has been applied",
     "10","Destination not responding, call reattempted",
     );

sub PROGRESS {
    $_[3] =~ /^.(.)(..)/;

    print "ID ",$_[2]," progress: call on ",$netloc{$1},", ",$pdesc{$2};
    print " (cause code ",$causecode{$_[5]},")" if $_[5];
    print "\n";
}

%rreq =
    (
     "00","Hold",
     "01","Reconnect",
     "02","Conference",
     "03","Drop",
     "04","Transfer",
     );

sub REJECTED {
    print "ID ",$_[2],": ",$rreq{$_[3]}," rejected (",$causecode{$_[4]},")\n";
}

sub SCA {
    print "Call appearance ",$_[2]," selected\n";
}

%signal =
    (
     "00","Dial tone on",
     "01","Ring back (audible ring) tone on",
     "02","Intercept tone on",
     "03","Network congestion (reorder) tone on",
     "04","Busy tone on",

     "05","Confirm tone on",
     "06","Answer tone on",
     "07","Call waiting tone on",
     "08","Off-hook warning tone on",
     "09","Custom tone on",

     "0B","Busy verify tone on",
     "0C","Error tone on",
     "0D","Stutter dial tone on",
     "11","Recall dial tone on",
     "3F","Tones off",

     "40","Alerting on - Pattern 0 (1 ring burst)",
     "41","Alerting on - Pattern 1 (1 ring burst)",
     "42","Alerting on - Pattern 2 (1 ring burst)",
     "43","Alerting on - Pattern 3 (1 ring burst)",
     "44","Alerting on - Pattern 4 (1 ring burst)",

     "45","Alerting on - Pattern 5 (1 ring burst)",
     "46","Alerting on - Pattern 6 (1 ring burst)",
     "47","Alerting on - Pattern 7 (1 ring burst)",
     "4F","Alerting off",
     "60","Reserved by network",

     "7F","Undefined by network",
     "FD","Expensive route warning tone on",
     );

sub SIGNAL {
    print "ID ",$_[2],": ",$signal{$_[3]};
    print " (",$causecode{$_[4]},")" if $_[4];
    print "\n";
}

%subaddrtype =
    (
     "0","NASP",
     "2","User specified",
     );

sub SUBADDRESS {
    print("ID ",$_[2],": ",$partytype{$_[3]}," party has ",$subaddrtype{$_[4]},
	  " subaddress with ",($_[5]?"Odd":"Even"),
	  " number of subaddress signals.  Subaddress info is ",$_[6]);
}

$buf = "";

sub dealwithisdn {
    local($new,$line,$key,$args,@args);

    print "isdn ",sysread(PORT,$new,1024),"\n";

    $buf .= $new;

    while($buf =~ s/^(.*)\n//) {
	$line = $1;

	print "<<< ",$line,"\n" if $verbose;

	return if $line =~ /^\s*$/;

	&unparseisdn($line);
    }
}

sub dealwithuser {
    $_ = <STDIN>;

    chop;
    if (/^([^\s]+)\s*/) {
	$cmd = $1;
	$arg = $';
    } else {
	$cmd = "?";
	$arg = "";
    }

    if ($cmd =~ /^\?/i) {
	print "Ca/Feature Keypad Fixed LOcal Switchhooks Display LAmps Tones "
	    ,"Volume Adjunct Quote Exit\n";
    } elsif ($cmd =~ /^c/i || $cmd =~ /^f/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^k/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^f/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^lo/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^s/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^d/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^la/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^t/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^v/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^a/i) {
	print "Not implemented yet: ",$_,"\n";
    } elsif ($cmd =~ /^q/i) {
	&cmd($arg);
    } elsif ($cmd =~ /^e/i) {
	&fixterm();
    } else {
	print "Unknown: ",$_,"\n";
    }
}

$port = shift(@ARGV) || die "No port specified.\n";

open(PORT,"+>$port") || die "Couldn't open port: $!\n";
select((select(PORT),$|=1)[0]); $|=1;

$verbose = 0;

$SIG{"INT"} = "fixterm";

## BSD-style
#system("stty cbreak -echo 9600 -even -odd > $port");
#system("stty cbreak -echo -even -odd");

## POSIX-style
system("stty min 1 time 0 -istrip igncr -icanon -iexten opost onlcr -echo 9600 cs8 -parenb > $port");
#system("stty min 1 time 0 -icrnl -inlcr -icanon -iexten -echo cs8 -parenb");

vec($rin,fileno(STDIN),1) = 1;
vec($rin,fileno(PORT),1) = 1;

# setup isdn

&cmd("ATZ");			# reset phone
&cmd("AT&&I");			# reset isdn
&cmd("AT&&E1");			# enable extended codes
&cmd("AT&O1");			# make channel 1 current
&cmd("AT%A0=3");		# assign it to voice
&cmd("AT&D3");			# follow DTR

# monitor all

#&cmd("AT&&X0,1,0,1\n");		# CA/feature buttons
#&cmd("AT&&X0,2,0,1\n");		# Keypad buttons
#&cmd("AT&&X0,3,0,1\n");		# Fixed feature buttons
#&cmd("AT&&X0,4,0,1\n");		# Local buttons
#&cmd("AT&&X0,5,0,1\n");		# Switchhooks
#&cmd("AT&&X0,11,0,1\n");	# Display
#&cmd("AT&&X0,12,0,1\n");	# Lamps
#&cmd("AT&&X0,15,0,1\n");	# Tones
#&cmd("AT&&X0,16,0,1\n");	# Volume control
#&cmd("AT&&X0,17,0,1\n");	# Adjunct control

print "Go for it.\n";

while (1) {
    select($rout=$rin,undef,undef,undef);
    if (vec($rout,fileno(STDIN),1)) {
	&dealwithuser();
    } elsif (vec($rout,fileno(PORT),1)) {
	&dealwithisdn();
    } else {
	print "select: what?\n";
    }
}
