#!/usr/athena/bin/perl
# MIT Directory Gateway for HDML Cell Phones
# Rex Min (rmin@mit.edu)        December '99   
#   adapted from a zlocate CGI script by Matthew Gray (mkgray@mit.edu)

$query=$ENV{'QUERY_STRING'};

### Send HDML code to wireless phones with UP.Browser
$hdml= ($ENV{'HTTP_USER_AGENT'} =~ /UP\.Link/);

if (!defined($ENV{'REMOTE_ADDR'})) {
  $hdml = "true";  # spew HDML in interactive mode
  $query =join(' ', @ARGV);
}

if ($hdml) {
  print("Content-Type: text/x-hdml\n\n");
} else {
  print("Content-Type: text/html\n\n");
}

$query =~ s/\\//g;
($query, $matchstart) = split('&', $query); # matchstart=0 unless specified


print("\n");
&do_mitdir($query);

sub do_finger {
# Safe finger code adapted from finger.pl library by Eric Mumpower (nocturne)
        local($who, $where) = @_;

        if ( $where !~ /[\d{1,3}\.]{3}\d{1,3}/) {
            ($name,$aliases,$type,$len,@addrs) = gethostbyname($where);
        }
        else {
            ($name,$aliases,$type,$len,@addrs) = gethostbyaddr(pack('C4', split(
/\./, $where)), 2);
        }

        if ((! @addrs) || (@addrs[0] eq "")) {
            return "Error: Couldn't resolve host $where\n";
        }
  
        $sockaddr = 'S n a4 x8';

        # The port number for finger is 79
        $portnum = 79;

        ($name, $aliases, $proto) = getprotobyname("tcp");

        # Make the socket filehandle.

        if (! socket(S, &main'AF_INET, &main'SOCK_STREAM, $proto)) {
            return "Error: Cannot open socket for finger because:\n", $!, "\n";
        }

        if (! connect(S,pack($sockaddr, &main'AF_INET, $portnum, @addrs[0]))) {
            if ($! eq "Connection refused") {
                return "Error: Finger connection refused at $where.";
            }
            else {
                return "Cannot connect to finger socket at remote machine becaus
e: \n", $!, "\n";
            }
            return;
        }

        # Set socket to be command buffered.

        select(S); $| = 1; select(STDOUT);

        # send query

        print S "$who\r\n";

        return  join('', <S>);

}

sub do_mitdir {
    local($name, $result, *ZL) = @_;
  if ($hdml) {
    if($name){
        $result = &do_finger($name, "mitdir");

        print "<HDML VERSION=3.0 PUBLIC=TRUE MARKABLE=TRUE> \n";
        print "<DISPLAY TITLE=\"Mitdir\"> \n";

    ### Name and Phone fields are used for pattern matching. Save those!
        $result =~ s/email://g;
        $result =~ s/Unknown//g;    ## looks bad hanging by itself
        $result =~ s/address://g;
        $result =~ s/city://g;
        $result =~ s/state://g;
        $result =~ s/department://g;
        $result =~ s/school://g;
        $result =~ s/title://g;
        $result =~ s/office:/   ofc:/g;
        ($_, $_) = split(/1 match to your request\./, $result);
        if ($_) {
          print "Query $query returns: <BR>\n";
          s/name://g;
          @result = split(/\n/, $_);

          foreach (@result)  {
            chop;     # kill that weird character at end of line in $_
            if (/phone/) {
              ($junk, $rawnum) = split(/\:/);   
              $rawnum =~ tr/0-9//cd;	# extract digits of phone number
              tr/)/-/;   # massage text into form aaa-xxx-yyyy and rmv spaces
              tr/( //d;
              s/phone[^:]*\:(.*)/<A TASK=CALL LABEL=Call NUMBER=$rawnum>$1<\/A>/
            }
            print $_, " <BR>\n" unless (/^\s*$/);  # supress blank lines
          }
          print "</DISPLAY> \n</HDML>\n";
          exit;
        } 

        ($_, $matches, $_) = split(/(\d+) matches to your request\./, $result);
        if (($matches - $matchstart) < 10) {$matchend = $matches - 1;}
        else {$matchend = $matchstart + 9}; 
        if ($_) {
          if (($matchend + 1) == $matches && $matches <= 10) {
            print "$matches matches for $query: <BR>";
          } else {
            print "Matches ", $matchstart+1, " to ", $matchend+1, 
                  " of $matches for $query: <BR>";
          }
          print "--- <BR>";
          ($_, $_) = split(/\..*\n\s*\n/);
          @result = split(/\n\s*\n/, $_);
          

          for ($i = $matchstart; $i <= $matchend; $i++)  {
            $_ = @result[$i];
	    s/\r//g;
            ($_, $alias) = split(/\n.*alias:/);
            $alias =~ s/\s//g;
	    s/name:(\s*)(.*)\n/$1<A TASK=GO LABEL=Query DEST=?$alias>$2<\/A>\n/;
            s/\n/ <BR>\n/g;
            print $_, "<BR>---<BR>\n" unless (/^\s*$/);  # supress blank lines
          }
          if (($matchend + 1) != $matches) {
             $matchend += 1;
             print "<A TASK=GO LABEL=More DEST=?$query&$matchend>More...</A>";
          }
          print "</DISPLAY> \n</HDML>\n";
          exit;
        } 

        if ($result =~ /[Nn]o matches/) {
          print "No matches for query $query. \n</DISPLAY> \n</HDML>";
          exit;
        }

        if ($result =~ /[Tt]oo many/) {
          print "Too many matches for query $query. Please refine. \n</DISPLAY> \n</HDML>";
          exit;
        }

        if ($result =~ /[Dd]id not understand/) {
          print "The directory did not understand your query of $query. \n</DISPLAY> \n</HDML>";
          exit;
        }

        if ($result =~ /[Qq]uery refused/) {
          print "Service temporarily unavailable. Please try again later. \n</DISPLAY> \n</HDML>";
          exit;
        }

        if ($result =~ /[Ee]rror:/) {
          print "Your request failed due to a network error. Feel free to retry. \n</DISPLAY> \n</HDML>";
          exit;
        }

# One of the cases above should always match. If none do, then the
# MIT directory format must have changed and this script must be
# updated. 

        print "The Perl script that provides this service has failed. \n";
        print "Please notify its maintainer so that this service may \n";
        print "be restored for everyone as soon as possible. \n";
        print "</DISPLAY> \n</HDML>";
    }
    else{
	print <<"end_msg";    
<HDML VERSION=3.0 PUBLIC=TRUE MARKABLE=TRUE>
  <ENTRY TITLE = "Mitdir" KEY=zu>
     <ACTION TYPE=ACCEPT LABEL=Query TASK=GO DEST="?\$(zu:e)">
     MIT Directory Query: 
  </ENTRY>
</HDML>
end_msg
      } 
    }
else {     ########## HTML CODE #########
#
#  We reject HTML-based queries for two reasons: 
#    (1) you can get the information just as easily with finger
#    (2) serving them would count against our query quota on mitdir!
#
	print <<"end_msg";
<html><head><title>HDML MIT Directory Lookup Service (information)</title></head><body>
<h1>HDML MIT Directory Lookup Service</h1>

<p>This service provides a gateway to the MIT on-line directory 
for wireless phones capable of accessing HDML web pages. You can obtain
the identical information from your computer by 
<a href="/finger">fingering</a> <i>myquery\@mit.edu</i>. </p>
<p>If you have a web-capable phone, you may point it to the URL of
this page to access the MIT on-line directory. </p>

</body></html>
end_msg
       }
    }

1;