cgit.sxemacs.org Git - packages/blob - xemacs-packages/bbdb/utils/bbdb-cid.pl

   1 #!/usr/local/bin/perl5 -w
   2 #
   3 # Caller-ID-logger, by jwz (19-Jan-97)
   4 # Modified: 24-Apr-97
   5 #
   6 # Opens the modem and waits for it to print caller-ID data.  When it does,
   7 # it logs it to a file, parses it, and pops up a window using "xmessage".
   8 # If the number is present in your .bbdb file, it shows the name (or company)
   9 # associated with it.
  10 #
  11 # Todo:
  12 #  My caller ID service (in San Francisco) only ever sends numbers, not names,
  13 #  so I've never seen a "name" line come in; I assume that it would send both
  14 #  a name and a number, so it would be nice to present both (with error
  15 #  checking against BBDB) but the code as currently structured only handles
  16 #  one-line-per-call.  It should realize that consecutive lines with the same
  17 #  timestamp are the same call.
  18 #
  19 #  Modems other than ZyXELs have different caller-ID formats, and this doesn't
  20 #  deal with those.
  21
  22 ##############################################################################
  23 #
  24 # Some variables you might want to set...
  25
  26
  27 # Set this to the device that your modem is attached to.
  28 #
  29 $modem_device = "/dev/ttyd1";
  30
  31 # This is your .bbdb file.  (Set it to null if you don't want to do BBDB
  32 # lookups at all, but why would you want to go and do a thing like that?)
  33 #
  34 $bbdb_file    = "$ENV{HOME}/.bbdb";
  35
  36 # A shell command to use to cause emacs to pop up the BBDB buffer
  37 # (bbdb-srv.pl is a good choice, so it defaults to the value of the
  38 # shell environment variable $NS_MSG_DISPLAY_HOOK.)
  39 #
  40 $bbdb_cmd     = $ENV{NS_MSG_DISPLAY_HOOK};
  41
  42 # If you want the $bbdb_cmd to be run on a different host, set it here.
  43 #
  44 $bbdb_host    = "gimp";
  45
  46 # If you want each call to be logged to a file as well, name it here.
  47 #
  48 $logfile      = "/usr/spool/fax/log/cid-log";
  49
  50 # For verbosity...
  51 $debug        = 0;
  52
  53 # How to pop up a dialog box.
  54 #
  55 $xmessage_cmd   = "xmessage";
  56 @xmessage_args  = ("-display",  ":0",
  57                    "-name",     "Caller ID",
  58                    # roughly centered on my screen; YMMV.
  59                    "-geometry", "+400+400",
  60                    "-xrm",      "*Font: -*-new cent*-bold-r-normal-*-240-*",
  61                    "-xrm",      "*Foreground: black",
  62                    "-xrm",      "*Background: lightgreen",
  63                    # no buttons on the window: dismiss it by clicking in it.
  64                    "-button",   "",
  65                    "-xrm", "*form.Translations: #override <BtnDown>: exit(0)",
  66                    "-xrm", "*Command.Font: -*-new cent*-bold-r-normal-*-120-*",
  67                    "-xrm", "*Command.horizDistance: 130"
  68                    );
  69
  70 # Uh, let's turn off the screensaver before popping up the window.
  71 #
  72 $pre_dialog_cmd = "xscreensaver-command -deactivate";
  73
  74
  75 # commands (and their expected responses) used to initialize the modem.
  76 #
  77 @modem_init   = ( "AT",         "OK",           # ping
  78                   "ATZ",        "OK",           # reset
  79                   "ATE0",       "OK",           # don't echo commands
  80                   "ATM0",       "OK",           # turn off speaker
  81                   "ATN0",       "OK",           # turn off ringer
  82                   "ATS40.2=1",  "OK",           # turn on caller ID
  83                 );
  84
  85
  86 # for diagnostics: if the modem ever asynchronously prints something that
  87 # doesn't match this, we issue a warning.
  88 #
  89 $expected_responses = "^CALLER NUMBER"          . "|" .
  90                       "^REASON FOR NO CALLER "  . "|" .
  91                       "^RING"                   . "|" .
  92                       "^TIME: [-0-9: ]+\$";
  93
  94 \f
  95 ##############################################################################
  96 #
  97 # Talking to the serial port...
  98 #
  99 #
 100
 101 if ( $ debug ) {
 102     use diagnostics;
 103 }
 104
 105
 106 sub open_modem {
 107     use IPC::Open2;
 108
 109     # Close the terminal streams before forking `cu', because otherwise
 110     # it fucks around with the stty settings.
 111     #
 112     open(SAVEIN,  "<&STDIN")  || die("can't dup stdin");
 113     open(SAVEOUT, ">&STDOUT") || die("can't dup stdout");
 114     open(SAVEERR, ">&STDERR") || die("can't dup stderr");
 115     close(STDIN);
 116     close(STDOUT);
 117     close(STDERR);
 118
 119     my $cu_pid = open2( \*MODEM_IN, \*MODEM_OUT,
 120                        "cu -l$modem_device -s2400 2>&1");
 121
 122     # Now that cu has been launched, we can restore them.
 123     #
 124     open(STDIN,  "<&SAVEIN")  || die("can't restore stdin");
 125     open(STDOUT, ">&SAVEOUT") || die("can't restore stdout");
 126     open(STDERR, ">&SAVEERR") || die("can't restore stderr");
 127     close(SAVEIN);
 128     close(SAVEOUT);
 129     close(SAVEERR);
 130
 131     # The following doesn't seem to work and I don't know why...
 132     #
 133     # Set up a signal handler to try and kill off the cu process
 134     # when we exit, instead of waiting ~30 seconds for it to notice
 135     # that the pipe is gone...
 136     #
 137 #    $SIG{INT} = sub { my $signame = shift;
 138 #                     if ( $debug) {
 139 #                         print STDERR "sending $signame to $cu_pid\n";
 140 #                     }
 141 #                     print MODEM_OUT "\r\n~.\r\n";
 142 #                     close MODEM_OUT;
 143 #                     close MODEM_IN;
 144 #                     kill ($signame, $cu_pid);
 145 #                     exit (1);
 146 #                   };
 147
 148     $_ = <MODEM_IN>;
 149     chop;
 150     if ( !m/^Connected/ ) {
 151         print STDERR "$0: cu printed `$_' instead of `Connected'\n";
 152     }
 153 }
 154
 155 sub read_line {
 156     $_ = <MODEM_IN>;
 157     $_ || die("got eof on modem");
 158     s/[\r\n]+$//;
 159     if ( $_ eq "" ) {
 160         $_ = <MODEM_IN>;
 161         $_ || die("got eof on modem");
 162         s/[\r\n]+$//;
 163     }
 164     return $_;
 165 }
 166
 167 sub command {
 168     my ( $command, $expected_response) = @_;
 169
 170     if ( $debug ) {
 171         print STDERR "sending: $command\n";
 172     }
 173
 174     print MODEM_OUT "$command\r\n";
 175     my $line = read_line();
 176
 177     if ( $line eq $command ) {
 178         if ( $debug ) {
 179             print STDERR "    got echo: reading next line too...\n";
 180         }
 181         $line = read_line();
 182     }
 183
 184     if ( $line ne $expected_response ) {
 185         print STDERR "    got: $line ; expected: $expected_response\n";
 186     } elsif ( $debug ) {
 187         print STDERR "    got: $line\n";
 188     }
 189 }
 190
 191 sub init_modem {
 192     open_modem;
 193
 194     my $len = $#modem_init + 1;
 195     my $i;
 196     for ($i = 0; $i < $len; $i += 2) {
 197         command($modem_init[$i], $modem_init[$i+1]);
 198     }
 199 }
 200
 201 sub handle_async_line {
 202     local ( $_ ) = @_;
 203
 204     if (!m/$expected_responses/) {
 205         print STDERR "modem turd:   $_\n";
 206
 207     } elsif (m/CALLER/) {
 208         if ( $debug ) {
 209             print STDERR "caller: $_\n";
 210         }
 211         handle_cid_line($_);
 212
 213     } elsif ( $debug ) {
 214         if ( $_ eq '' ) {
 215             print STDERR "ignored: blank line\n";
 216         } else {
 217             print STDERR "ignored: $_\n";
 218         }
 219     }
 220 }
 221
 222 \f
 223 ##############################################################################
 224 #
 225 # Parsing BBDB and CID data...
 226 #
 227
 228 sub find_bbdb_record {
 229     my ( $area, $exchange, $suffix ) = @_;
 230
 231     if ( ! $bbdb_file ) {
 232         return undef;
 233     }
 234
 235     # strip off leading 0's, to match the way it's stored in .bbdb.
 236     $area     =~ s/^0+(.)/$1/;
 237     $exchange =~ s/^0+(.)/$1/;
 238     $suffix   =~ s/^0+(.)/$1/;
 239
 240     my $bbdb_rec = undef;
 241     my $pat = "\\[\"[^\"]+\" $area $exchange $suffix (nil|[0-9]+)\\]";
 242
 243     open(BBDB, "<$bbdb_file") || die("error opening $bbdb_file: $!\n");
 244
 245     while (<BBDB>) {
 246         if ( m/$pat/ ) {
 247             $bbdb_rec = $_;
 248             last;
 249         }
 250     }
 251     close(BBDB);
 252     return $bbdb_rec;
 253 }
 254
 255
 256 # note: global (kludge!)
 257 $pretty_number = 0;
 258
 259 sub make_message_string {
 260     my ( $number, $date, $fn, $ln, $co, $error ) = @_;
 261     my $msg;
 262
 263     my $line_prefix = "    ";
 264     my $line_suffix = "    ";
 265
 266     # First print the date (reformatted.)
 267     #
 268     $_ = $date;
 269     my ( $dotw, $mon, $day, $hr, $min, $sec, $year ) =
 270         m/^([^ ]+) +([^ ]+) +([^ ]+) +([^:]+):([^:]+):([^:]+) +([^ ]+) *$/;
 271     $year =~ s/^..(..)/$1/;
 272     $day  =~ s/^0//;
 273     $hr   =~ s/^0//;
 274     if ($hr < 12) {
 275         $ampm = "am";
 276     } else {
 277         $ampm = "pm";
 278         if ($hr > 12) { $hr -= 12 };
 279     }
 280     $date = "$hr:$min$ampm, $day-$mon-$year ($dotw)";
 281     $msg = $line_prefix . $date . $line_suffix;
 282
 283     # Next print the caller name, company, or error message.
 284     #
 285     if ( $error ) {
 286         $msg .= "\n" . $line_prefix . $error . $line_suffix;
 287     } elsif ( $co && !$fn && !$ln ) {
 288         $msg .= "\n" . $line_prefix . $co . $line_suffix;
 289     } elsif ( $fn || $ln ) {
 290         $msg .= "\n" . $line_prefix . "$fn $ln" . $line_suffix;
 291     }
 292
 293     # Next print the phone number (formatted nicely.)
 294     #
 295     if ( $number ) {
 296         my $area = 0;
 297         my $exchange = 0;
 298         my $suffix = 0;
 299         $_ = $number;
 300         ( $area, $exchange, $suffix ) =
 301             m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/;
 302
 303         # note: global (kludge!)
 304         $pretty_number = "($area) $exchange-$suffix";
 305         $msg .= "\n" . $line_prefix . $pretty_number . $line_suffix;
 306     }
 307
 308     return $msg;
 309 }
 310
 311 use POSIX;
 312 sub reaper {
 313     $SIG{CHLD} = \&reaper;  # loathe sysV
 314     my $signame = shift;
 315     if ( $debug >= 2 ) {
 316         printf STDERR "  (got SIG$signame...)\n";
 317     }
 318     my $child;
 319     while ( ( $child = waitpid(-1,WNOHANG) ),
 320             $child > 0 ) {
 321         if ( $debug >= 2 ) {
 322             printf STDERR "    (pid $child exited with $?)\n";
 323         }
 324     }
 325 }
 326
 327 sub fork_and_exec {
 328     my @cmd_list = @_;
 329
 330     $SIG{CHLD} = \&reaper;
 331
 332     if ( $debug >= 2 ) {
 333         $_ = $cmd_list[0];
 334         s/ .*//;
 335         print STDERR "forking for " . $_ . " at " . (localtime) . ".\n";
 336     }
 337
 338     my $pid;
 339     if ($pid = fork()) {
 340         # parent
 341     } elsif (!defined $pid) {
 342         print STDERR "$0: fork failed: $!\n";
 343     } else {
 344         # child
 345
 346         if ( $debug ) {
 347             $_ = $cmd_list[0];
 348             s/ .*//;
 349             print STDERR "exec'ing " . $_ . " at " . (localtime) .
 350                 " in pid $$.\n";
 351         }
 352         close(STDIN);
 353         close(STDOUT);
 354         close(STDERR);
 355         exec @cmd_list;
 356     }
 357 }
 358
 359
 360 sub fork_and_exec_for_bbdb {
 361     my @cmd_list = @_;
 362     my $number = shift @cmd_list;
 363
 364     $SIG{CHLD} = \&reaper;
 365
 366     if ( $debug >= 2 ) {
 367         $_ = $cmd_list[0];
 368         s/ .*//;
 369         print STDERR "forking for " . $_ . " at " . (localtime) . ".\n";
 370     }
 371
 372     my $pid;
 373     if ($pid = fork()) {
 374         # parent
 375     } elsif (!defined $pid) {
 376         print STDERR "$0: fork failed: $!\n";
 377         exit (1);
 378     } else {
 379         # child
 380
 381         if ( $debug ) {
 382             $_ = $cmd_list[0];
 383             s/ .*//;
 384             print STDERR "exec'ing " . $_ . " at " . (localtime) .
 385                 " in pid $$.\n";
 386         }
 387         if ( system @cmd_list ) {
 388             my $cmd = "gnudoit -q '(bbdb-srv-add-phone \"$pretty_number\")'";
 389             if ( $bbdb_host ) {
 390                 $cmd =~ s/([()\"])/\\$1/g;
 391                 $cmd = "rsh $bbdb_host $cmd";
 392             }
 393             exec $cmd;
 394         }
 395         exit (0);
 396     }
 397 }
 398
 399
 400 sub pop_up_dialog {
 401     my ( $msg, $buttonp, $number ) = @_;
 402
 403     fork_and_exec $pre_dialog_cmd;
 404
 405     if ( ! $buttonp ) {
 406         fork_and_exec $xmessage_cmd, @xmessage_args, "\n$msg\n\n";
 407     } else {
 408         my @args = ( @xmessage_args, "-button", "Add To BBDB" );
 409         fork_and_exec_for_bbdb $number, $xmessage_cmd, @args, "\n$msg\n\n";
 410     }
 411 }
 412
 413 sub pop_up_bbdb_buffer {
 414     my ( $caller ) = @_;
 415     if ( $bbdb_cmd ) {
 416         my $cmd = $bbdb_cmd;
 417         if ( $bbdb_host ) {
 418             $cmd = "rsh $bbdb_host $cmd";
 419         }
 420         $caller =~ s/\\/\\\\/g;
 421         $caller =~ s/\"/\\\\\"/g;
 422         `echo "Path:\nFrom: \\\"$caller\\\" <>" | $cmd >&- 2>&- &`;
 423     }
 424 }
 425
 426
 427 sub handle_cid_line {
 428     my($line) = @_;
 429
 430     my $date = localtime;
 431
 432     # Log the call...
 433     #
 434     if ( $logfile ) {
 435         if (open(LOG, ">>$logfile")) {
 436             print LOG "$date\t$line\r\n";
 437             close LOG;
 438         } else {
 439             print STDERR "error opening $logfile: $!\n";
 440         }
 441     }
 442
 443     # Pull the phone number out of the message...
 444     #
 445     my $number = "";
 446     my $error = "";
 447
 448     $_ = $line;
 449     if ( m/^CALLER NUMBER/ ) {
 450         ( $number ) = m/^[^:]+: *(.*) *$/;
 451     } else {
 452         $error = $line;
 453     }
 454
 455     my $caller = undef;
 456
 457     my $fn = undef;
 458     my $ln = undef;
 459     my $co = undef;
 460     my $buttonp = 0;
 461
 462     if ( !$number || $number eq "" ) {
 463         $error =~ tr#A-Z#a-z#;
 464         $error =~ s/^REASON FOR NO CALLER (NUMBER|NAME)/Caller unknown/i;
 465
 466     } else {
 467         $_ = $number;
 468
 469         my $area = 0;
 470         my $exchange = 0;
 471         my $suffix = 0;
 472         ( $area, $exchange, $suffix ) =
 473             m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/;
 474
 475         my $bbdb_rec = find_bbdb_record($area, $exchange, $suffix);
 476
 477         if ( $bbdb_rec ) {
 478             my $junk = 0;
 479             $_ = $bbdb_rec;
 480             # This will lose if names or aliases have double-quotes in them.
 481             # No doubt there's some hairier regexp magic that handles that...
 482             ( $fn, $ln ) = m/^[\[]\"([^\"]*)\" *\"([^\"]*)\"/;
 483             ( $junk, $junk, $junk, $co ) =
 484       m/^[[](nil|\"[^\"]*\") *(nil|\"[^\"]*\") (nil|[(][^)]*[)]) \"([^\"]*)\"/;
 485
 486             if ( $fn || $ln ) {
 487                 $caller = "$fn $ln";
 488             }
 489         } else {
 490             $buttonp = 1;
 491         }
 492     }
 493
 494     my $msg = make_message_string($number, $date, $fn, $ln, $co, $error);
 495     pop_up_dialog($msg, $buttonp, $pretty_number);
 496
 497     if ( $caller ) {
 498         pop_up_bbdb_buffer($caller);
 499     }
 500 }
 501
 502 \f
 503 ##############################################################################
 504 #
 505 # hey ho.  let's go.
 506 #
 507 sub main {
 508     init_modem();
 509     while (1) {
 510         handle_async_line(read_line());
 511     }
 512     exit (1);
 513 }
 514
 515 main();
 516