#!/usr/local/bin/perl
# fingerrc --- user rc file for use with GNU finger
# Author: Noah Friedman <friedman@prep.ai.mit.edu>
# Created: 1992-08-02
# Public domain

# $Id: fingerrc,v 1.2 1996/11/21 07:26:16 friedman Exp $

# Commentary:

# Requires GNU finger version 1.03 or later.
#
# This does everything GNU or BSD finger normally do, plus a little more
# (such as listing all of the user's groups).

# Code:

&main;

sub main
{
  # Untaint it if fingerd runs this script setgid.
  $ENV{'PATH'} = &getenv ('PATH');

  if (length ("@ARGV") == 0)
    {
      ($uname, $passwd, $uid, $gid, $quota, $comment, $real_name, $home, $shell) = getpwuid ($>);
    }
  else
    {
      ($uname, $passwd, $uid, $gid, $quota, $comment, $real_name, $home, $shell) = getpwnam ("$ARGV[0]");
      if ("$uname" eq "")
        {
          exit (1);
        }
    }

  # SMTP server for expanding mail aliases
  #$SMTPHOST = "localhost";
  $SMTPHOST = "albert";

  # Canonical spool file
  $SPOOLFILE = "/usr/spool/mail/$uname";

  # Kludge: I use my VM inbox file because that's a more accurate reflection
  # of when I last read my mail.  I have automated programs that grep through
  # my spool file all the time, so the atime on that isn't any good.
  #$inbox = $home . "/etc/mail/inbox";

  &print_passwd_info;
  &print_lastlog;
  &print_forwarding_alias;
  &print_unread_mail_age ($SPOOLFILE, $inbox);
  #&print_number_new_msgs ($SPOOLFILE);
  &print_project;
  &print_plan;

  # As of GNU finger 1.38, this causes .fingerrc to be run recursively.
  #system ("finger $uname");
  #print ("\n\n");

  &flushprint;
}

sub printline
{
  @PRINTLINES = (@PRINTLINES, @_);
}

sub flushprint
{
  local ($i) = 0;

  while ("$PRINTLINES[$i]")
    {
      print ("$PRINTLINES[$i]");
      $i++;
    }
}

sub print_passwd_info
{
  local (@groups);
  local (@gcos) = split (",", $real_name);


  &printline (sprintf ("Login name: %-27s In real life: %s\n", $uname, $gcos[0]));

  if ("$gcos[1]$gcos[2]$gcos[3]" ne "")
    {
      &printline (sprintf ("Office: %-31s Home: %s\n",
                           "$gcos[1], " . &phonefmt($gcos[2]),
                           &phonefmt($gcos[3])));
    }

  &printline (sprintf ("Directory: %-28s Shell: %s\n", $home, $shell));
  @groups = &getgroupsbyname ($uid);
  &printline ("Groups: @groups\n");
}

sub phonefmt
{
  local ($num) = @_;
  local ($len) = length ($num);
  local ($new);

  if ($len <= 4)
    {
      return "$num";
    }

  $new = substr ("$num", $len - 4);
  $num = substr ("$num", 0, $len - 4);
  $len -= 4;

  while ($len > 0)
    {
      $new = substr ("$num", &max ($len - 3, 0)) . "-$new" ;
      $num = substr ("$num", 0, &max ($len - 3, 0));
      $len -= 3;
    }

  if ("$num")
    {
      $new = "$num-$new";
    }

  return "$new";
}

sub max
{
  return ($_[0] > $_[1]) ? $_[0] : $_[1] ;
}

sub getgroupsbyname
{
  local ($uid) = @_;
  local ($uname, $passwd, $gid, $gname, $members, @groups);

  if ($uid =~ /[0-9][0-9]*/)
    {
      ($uname, $passwd, $uid, $gid) = getpwuid ($uid);
    }
  else
    {
      ($uname, $passwd, $uid, $gid) = getpwnam ($uid);
    }

  if ("$uname" eq "")
    {
      return ();
    }

  if (($gname) = getgrgid ($gid))
    {
      @groups = ($gname);
    }

  while (($gname, $passwd, $gid, $members) = getgrent ())
    {
      if ("$members" =~ /^$uname /o
          || "$members" =~ / $uname /o
          || "$members" =~ / $uname$/o
          || "$members" =~ /^$uname$/o)
        {
          @groups = (@groups, $gname);
        }
    }
  return @groups;
}

sub print_lastlog
{
  local ($tm, $tty, $rhost) = &lastlog ($uid);
  local ($host) = `hostname`;

  chop $host;

  if ($tm == 0)
    {
      &printline (sprintf ("Never logged in to this host (%s).\n", $host));
      return;
    }
  &printline (sprintf ("Last login to %s %s on $tty from $rhost\n",
                       $host, &ctime ($tm)));
}

# Returns (time, tty, rhost)
sub lastlog
{
  local ($uid, $logfile) = @_;
  local ($ll_template, @ll_fodder, $ll_size, $ll_info);
  local ($dummy, @lastlog_entry);

  if ($uid !~ /[0-9][0-9]*/)
    {
      ($dummy, $dummy, $uid) = getpwnam ($uid);
    }

  if ($logfile eq '')
    {
      foreach $file ('/var/log/lastlog', '/usr/adm/lastlog')
        {
          if (-f $file)
            {
              $logfile = $file;
              break;
            }
        }
      return '' if ($logfile eq '');
    }

  if (open (FILE, "< $logfile"))
    {
      # Linux
      $ll_template = "LA12A16";
      @ll_fodder = (0, 0 x 12, 0 x 16);

      # Other systems?
      #$ll_template = "LA8A16";
      #@ll_fodder = (0, 0 x 8, 0 x 16);

      $ll_size = length (pack ($ll_template, @ll_fodder));
      seek (FILE, $ll_size * $uid, 0);

      read (FILE, $ll_info, $ll_size);
      close (FILE);

      @lastlog_entry = unpack ($ll_template, $ll_info);

      return @lastlog_entry;
    }
}

sub print_unread_mail_age
{
  local ($SPOOLFILE, $inbox) = @_;
  local (@st_info, $st_atime, $st_mtime);

  @st_info = stat ("$SPOOLFILE");
  if ($st_info[7] == 0) # $st_info[7] is st_size
     {
       &printline ("No unread mail.\n");
       return (0);
     }
  $st_atime = $st_info[8];
  $st_mtime = $st_info[9];

  # If $inbox argument is non-null and actually exists, use the atime on
  # that instead, since it probably is a more accurate reflection of when
  # mail was really last read.
  if ("$inbox" ne "")
    {
      @st_info = stat ("$inbox");
      if ($st_info[1] != 0) # $st_info[1] is st_ino
        {
          # Yes, in this case st_atime is really the mtime of the file,
          # since "the last time I read mail" is the last time I modified
          # my inbox by incorporating it.
          $st_atime = $st_info[9];
        }
    }

  &printline ("New mail last arrived " . &ctime ($st_mtime) . ".\n");
  &printline ("Has not read mail for " . &age_of ($st_atime) . ".\n");
}

sub age_of
{
  local (@time_mult, @time_name, $seconds, $output, $val, $i);

  @time_mult = (31536000, 2592000, 86400, 3600,   60);
  @time_name = ("year",   "month", "day", "hour", "minute");

  $seconds = time () - $_[0];

  $output = "";
  for ($i = 0; $i <= $#time_mult; $i += 1)
    {
      $val = int ($seconds / $time_mult[$i]);
      $seconds -= $val * $time_mult[$i];
      if ($val != 0 || (length ($output) == 0 && $i == $#time_mult))
        {
          if (length ($output) > 0)
            {
              $output = "$output" . ", ";
            }
          $output = "$output" . "$val $time_name[$i]" ;
          if ($val != 1)
            {
              $output = "$output" . "s" ;
            }
        }
    }
  return "$output";
}

sub print_forwarding_alias
{
  local (@aliases) = &expand_mail_alias ($SMTPHOST, $uname);
  local ($str, $i);

  # If there's only one alias, and it's identical to the username, it means
  # there's no mail forwarding for this user.
  local ($len) = length (@aliases);

  if ($len <= 0 || ($len == 1 && "$aliases[0]" eq "$uname"))
    {
     return 0;
    }

  $str = $aliases[0];
  $i = 1;
  while ("$aliases[$i]")
    {
      $str .= ", $aliases[$i]";
      $i++;
    }
  &printline ("Mail forwarded to $str.\n");
  return 1;
}

# Args: smtphost, alias
sub expand_mail_alias
{
  local ($rhost, $username) = @_;
  local ($name, $aliases, $type, $len, $thisaddr, $rhostaddr);
  local ($proto, $child, $i, @result);

  local ($port) = 25;
  local ($sockaddr) = "S n a4 x8";

  # So we don't have to include socket.ph
  # These are probably correct, but not guaranteed to be.
  local ($AF_INET) = 2;
  local ($SOCK_STREAM) = 1;

  #local ($hostname) = `hostname`;
  #chop $hostname;

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

  if ($port !~ /^\d+$/)
    {
      ($name, $aliases, $port) = getservbyname ($port, "tcp");
    }

  #($name, $aliases, $type, $len, $thisaddr) = gethostbyname ($hostname);
  ($name, $aliases, $type, $len, $rhostaddr) = gethostbyname ($rhost);

  #$thishost = pack ($sockaddr, $AF_INET, 0, $thisaddr);
  $rhost    = pack ($sockaddr, $AF_INET, $port, $rhostaddr);

  # Make socket filehandle.
  socket (S, $AF_INET, $SOCK_STREAM, $proto) || die ("$0: socket: $!");

  # Give the socket an address.
  # There is no need to bind client-side sockets.
  #bind (S, $thishost) || die ("$0: bind: $!");

  # Connect to server.
  connect (S, $rhost) || die ("$0: connect: $!");

  # Set socket to be command buffered.
  select (S); $| = 1; select (STDOUT);

  # Avoid deadlock by forking.
  $child = fork();

  if ($child == 0)
    {
      # child
      print (S "expn $username\n");
      print (S "quit\n");
      close (S);
      exit (0);
    }
  else
    {
      $i = 0;
      while (<S>)
        {
          if ($_ =~ /^250[- ]/)
            {
              s/.*<//;
              s/>.*//;
              chop;
              $result[$i] = $_;
              $i++;
            }
        }
      close (S);
    }

  return @result;
}

# Count new mail messages.
# First, save access time.  Restore it after having munged it by opening
# file.  Yes, I fully realize this has race conditions.  Big deal.
sub print_number_new_msgs
{
  local ($SPOOLFILE) = $_[0];
  local (*st_info, *n, *atime);

  @st_info = stat ("$SPOOLFILE");
  if (open (FILE, "< $SPOOLFILE"))
    {
      $n = 0;
      while (<FILE>)
        {
          if (/^From /)
            {
              $n++;
            }
        }
      close (FILE);
      # Restore access time.  Try to leave mtime at whatever it was just
      # before this call (it may have changed since the first stat)
      $atime = $st_info[9];
      @st_info = stat ("$SPOOLFILE");
      utime ($atime, $st_info[10], $SPOOLFILE);

      if ($n == 1)
        {
          &printline ("Has $n new mail message.\n");
        }
      else
        {
          if ($n > 1)
            {
              &printline ("Has $n new mail messages.\n");
            }
        }
    }
}

sub print_project
{
  if (open (FILE, "< " . $home . "/.project"))
    {
      &printline ("Project: " . <FILE>);
      close (FILE);
    }
}

sub print_plan
{
  if (open (FILE, "< " . $home . "/.plan"))
    {
      &printline ("Plan:\n");
      while (<FILE>)
        {
          &printline ($_);
        }
      close (FILE);
    }
  else
    {
      &printline ("No plan.\n");
    }
}

sub ctime
{
  local (@weekday, @month, $time, $TZ);
  local ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

  @weekday = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
  @month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
            "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

  $time = (length (@_) > 0)? $_[0] : time() ;

  $TZ = 'GMT';
  if (&envp ('TZ'))
    {
      $TZ = &getenv ('TZ');
    }

  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
      ($TZ eq 'GMT') ? gmtime($time) : localtime($time);

  if ($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/)
    {
      $TZ = $isdst ? $4 : $1;
    }

  if ($TZ ne "") { $TZ .= " "; }

  $year += ($year < 70) ? 2000 : 1900;

  return sprintf ("%s %s %02d %02d:%02d:%02d %s%4d",
                  $weekday[$wday], $month[$mon], $mday, $hour, $min, $sec,
                  $TZ, $year);
}

sub envp
{
  local ($var) = @_;

  if (defined ($ENV{$var}) && $ENV{$var} ne '')
    {
      return 1;
    }
  return 0;
}

# This automatically "untaints" any values returned from the environment.
# This only matters when running setuid.
sub getenv
{
  local ($var) = @_;

  if (&envp ($var))
    {
      local ($taintval) = $ENV{$var};
      local ($val);


      $taintval =~ /^(.*)$/;
      $val = $1;                  # $1 is always untainted
      return $val;
    }
  return '';
}


# local variables:
# mode: c
# end:

# fingerrc ends here
