#!/usr/bin/perl -w
# For Emacs: -*- mode:cperl; mode:folding; -*-
#
# Get a machine's critical features, And mail/http them to the Linux Counter
#
# (c) 1999 - Harald Tveit Alvestrand, the Linux Counter Project
#     2003 - PetaMem Group (www.petamem.com)
# License:   GNU Copyleft - see bottom of file.
# Changelog: see even more bottom of the file
#
# As a matter of courtesy, if you change this file on your own,
# make sure it does NOT mail to the counter!
#
use strict;
use POSIX;

our $VERSION     = '0.25';
our $CVS_VERSION = '$Revision: 1.2 $ $Date: 2006-02-06 18:54:04 $ $Author: jonas $';
our $IsInTestHarness;
use vars qw(%values %oldvalues $errordata $debugdata %files); # data that is sent
use vars qw($progname %option);
use vars qw(%is_sys_account %is_user %is_account);

# stuff that controls defaults for passwdscan & accounts subroutines
my ($UID_MIN, $UID_MAX, $got_defs) = (100, 65533, '');

# Make sure nothing happens, so that the script's routines
# can be debugged from another file
return 1 if($IsInTestHarness);

&preparation;
&options;

&readfile;
&checkconfig;

if ($option{ask}) {
  &askquestions;
}

&writefile;
&sendfile;

# {{{ preparation

#
sub preparation {
  die "No HOME environment variable\n" if (!$ENV{HOME});
  die "No home diretory\n" if ! -d $ENV{HOME};
  # Kill some internationalization
  $ENV{LANG} = 'C';
  delete $ENV{LC_CTYPE};
  delete $ENV{LC_NUMERIC};
  delete $ENV{LC_NAME};
  delete $ENV{LC_TIME};
  delete $ENV{LC_MESSAGES};
  delete $ENV{LC_COLLATE};
  delete $ENV{LC_MONETARY};

  my $infodir = "$ENV{HOME}/.linuxcounter";
  if (! -d $infodir) {
    mkdir($infodir, 0766) || die "Unable to make $infodir\n";
  }
  # Keep track of where I am; need it to install crontab entry
  # progname is a global.
  $progname = $0;
  if ($progname !~ /^\//) {
    my $progdir = `pwd`;
    chop $progdir;
    $progname = "$progdir/$progname";
    $progname =~ s!/./!/!;
  }
  chdir($infodir) || die "Unable to change to $infodir\n";
  my ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname();
  if (! -f $nodename) {
    print STDERR "Machine-update $VERSION. Use $0 -l to display license.\n";
    print STDERR "Creating the infofile for your computer.\n";
    # Create the infodir
    open(INFO, ">$nodename");
    print INFO "uniqueid: ", randomnumber(), "\n";
    close INFO;
  }

  srand time % $$;            # do some seed "randomization"
}

# }}}
# {{{ options

#
sub options {
  my $opt;

  while (defined($ARGV[0]) && $ARGV[0] =~ /^-/) {
    $opt = shift @ARGV;
    $opt =~ /c/ && &installcrontab;
    $opt =~ /d/ && $option{DEBUG}++ && print STDERR "Debug is $option{DEBUG}\n";
    $opt =~ /h/ && &help;
    $opt =~ /i/ && ($option{ask}  = 1);
    $opt =~ /l/ && &license;
    $opt =~ /m/ && ($option{mail} = 1);
    $opt =~ /t/ && ($option{mail} = 0);
    $opt =~ /u/ && &uninstallcrontab;
    $opt =~ /v/ && die "\n\t Linux Counter machine-update version $VERSION\n"
      . "\tCVS version $CVS_VERSION\n";
    $opt =~ /x/ && ($option{info} = 1);
  }
}

# }}}

# {{{ askquestions

#
sub askquestions {
  return if ! -t STDIN || ! -t STDOUT;
  $| = 1;
  print "Here you can specify some info that the script can't know for itself\n";
  $values{owner} = askone("Your Linux Counter reg#, if any", $values{owner});
  $values{key}   = askone("Your machine's counter reg#, if any", $values{key});
}

# }}}
# {{{ askone
#
sub askone {
  my $prompt  = shift;
  my $default = shift;

  print $prompt;
  if (defined($default)) {
    print " [$default]";
  }
  print ':';

  my $ans = <STDIN>;

  chop $ans;
  &Debug("Answer was $ans\n");
  $ans = $default if (!length($ans));

  return $ans;
}
# }}}

# {{{ readfile

#
sub readfile {
  my ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname();
  open(INFO, $nodename) || die "Did not find infofile $nodename\n";
  while (<INFO>) {
    chop;
    s/#.*//;
    if (/^(\S+): *(.+)/) {
      my $key = $1;
      my $value = $2;
      if ($1 !~ /^(owner|key|uniqueid)$/) {
    next;
      }
      &Debug("Read $key: $value\n");
      $values{$key} = $value;
    } else {
      print STDERR "Unparsed info line: $_ - discarded\n";
    }
  }
  close INFO;
  %oldvalues = %values;
}

# }}}
# {{{ writefile

#
sub writefile {
  my ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname();

  open(INFO, ">$nodename.new");
  for my $val (sort keys(%values)) {
    &Debug("Saving $val: $values{$val}\n");
    print INFO "$val: $values{$val}\n";
  }
  close INFO;
  rename("$nodename.new", $nodename) || die "Rename failed\n";
}

# }}}
# {{{ sendfile

#
sub sendfile {
  if ($option{mail}) {
    open(MAIL, "|/usr/lib/sendmail machine-registration\@counter.li.org")
      || die "Unable to open sendmail\n";
  } else {
    warn "--------------------------------------------------------\n";
    warn "This is what will be sent to the Linux Counter if you\n";
    warn "run the program with the -m switch. Now, NOTHING IS SENT\n";
    warn "--------------------------------------------------------\n";
    open(MAIL, ">&STDOUT");
  }
  # note that $ENV{USER} isn't (always) set in a cron job...
  my $user = (getpwuid($<))[0];
  $user = "unknown-id-$<" if !$user;
  print MAIL <<EOF
From: $user
To: machine-registration\@counter.li.org
Subject: machine-update for $values{name}

//MACHINE
EOF
    ;
  for my $val (sort keys(%values)) {
    print MAIL "$val: $values{$val}\n"
      if length($values{$val}) > 0;
  }
  print MAIL "//END\n";
  # Attach files
  for my $file (keys(%files)) {
    print MAIL "//FILE $file\n";
    print MAIL $files{$file};
    print MAIL "//EOF\n";
  }


  # Attach possible other info
  if ($errordata) {
    print MAIL "----- Problem info gathered during probing -----\n";
    print MAIL $errordata;
  }
  $option{info} && do {
    print MAIL "----- Debug data for the script maintainer's aid -----\n";
    print MAIL $debugdata;
  };
  close MAIL;
}

# }}}

# {{{ randomnumber
#
sub randomnumber {
  return int(rand(1_000_000_000));
}
# }}}

# {{{ checkconfig

#
sub checkconfig {
  my ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname();

  warn "This is not Linux, but $sysname!\n" if($sysname ne 'Linux');
  $values{method}    = "machine-update version $VERSION";
  $values{os}        = $sysname;
  $values{kernel}    = $release;
  $values{cpu_uname} = $machine;
  $values{name}      = $nodename;   # First order guess

  # Credit for some of the code below goes to
  # Denis Havlik: <havlik@ap.univie.ac.at>
  # Blame is, of course, all mine - HTA -
  # Note - there are numerous problems with df, including:
  # - early versions don't support the -l option
  # - at least some include SAMBA filesystems in the -l option
  # 1: Snarf a df -T
  my $dfbin = &xbin("df");
  $files{"df -T"} = `$dfbin -T -x nfs`;

  $values{accounts} = &accounts;
  $values{users}    = &active_users;

  my $uptime = &xbin('uptime');
  if($uptime) {
    $uptime = `$uptime`;
    $values{uptime_1} = $uptime; # preserve raw version
    $values{uptime_1} =~ s/\n.*//;
  }
  my $lastprog = xbin('last');
  if ($lastprog && -r "/var/run/utmp") {
    $values{uptime_2} = `$lastprog -xf /var/run/utmp runlevel`;
    $values{uptime_2} =~ s/\n.*$//s;
  } else {
    DebugInfo("Can't do last to find uptime");
  }
  # Not sure this is a Right Thing...so not saving it for the moment
  # This section based on a patch from Mark-Jason Dominus <mjd@plover.com>
  # try to guess mailer based on content of /usr/lib/sendmail link
  if (-l '/usr/lib/sendmail') {
    my $realsendmail = readlink('/usr/lib/sendmail');
    if ($realsendmail eq '../sbin/sendmail') {
      $realsendmail = '/usr/sbin/sendmail';
      if (-l $realsendmail) {
    $realsendmail = readlink($realsendmail);
      }
    }
    if ($realsendmail =~ m{^/var/qmail}) {
      $values{mailer} = "qmail";
    } else {
      &DebugInfo("Found sendmail as a link to $realsendmail\n");
    }
  }
  # Link method did not work. Try to guess based on presence of
  # config files. (this is more susceptible to the old-junk problem)
  if (!$values{mailer}) {
    if ( -d '/var/qmail') {
      $values{mailer} = 'qmail';
    } elsif ( -f '/etc/sendmail.cf' || -f '/etc/mail/sendmail.cf') {
      # TMDG claims recent Fedora Core has it in /etc/mail/sendmail.cf
      $values{mailer} = 'sendmail';
    } elsif ( -d '/etc/postfix') {
      $values{mailer} = 'postfix';
    }
  }

  $values{kcoresize} = -s "/proc/kcore";
  addonefileforsending("/proc/meminfo");
  addonefileforsending("/proc/cpuinfo");
  addonefileforsending("/proc/version");
  # info on what devices are in use on the system
  addonefileforsending("/proc/pci");
  addonefileforsending("/proc/bus/usb/devices");
  # Both Mandrake and Red Hat use this file....
  addonefileforsending("/etc/redhat-release");
}

# }}}

# {{{ accounts

#
sub accounts {
  my $s;
  my $niss;
  my $ypcatbin;                # will hold path to the ypcat binary (if any)

  open (TMP,"</etc/passwd");
  $s += &passwdscan;
  &DebugErr("Found $s accounts total\n");
  &Debug("Switching to NIS passwords\n");

  $ypcatbin = &xbin('ypcat');  # get path to ypcat binary (empty if none)
  if($ypcatbin) {              # test whether ypcat was found
    open TMP, "$ypcatbin passwd 2> /dev/null|"
      || ($errordata .= "ypcat failed: $!\n");
    $niss = &passwdscan;
    $s   += $niss;
    close TMP;
    &Debug("Status of ypcat: $?\n");
    &DebugErr("Found $niss accounts in ypcat passwd\n");
  }

  &DebugErr('Sysaccounts: ', join(' ', keys(%is_sys_account)), "\n");
  &DebugErr("Found $s accounts total\n");

  return $s;
}

# }}}
# {{{ passwdscan

#
sub passwdscan {
  # Code for reading login.defs courtesy of Vassilii Khachaturov
  # <vassilii@tarunz.org>
  local (*DEFS);
  # Try importing UID_MIN and UID_MAX from /etc/login.defs, if possible
  # else just assume the above defaults for min and max non-system UID
  if (!$got_defs && open (DEFS, '/etc/login.defs')) {
    while (<DEFS>) {
      if (/^\s*(UID_(?:MIN|MAX))\s+(\d+)/) {
    # elegant, but not compatible with "strict refs":
    #${ $1 } = $2;
    if ($1 eq "UID_MIN") {
      $UID_MIN = $2;
    } else {
      $UID_MAX = $2;
    }
    &Debug("DEFS match: $1 = $2\n");
      }
    }
    close (DEFS);
    $got_defs = 1;
  }
  &Debug("UID_MIN = $UID_MIN, UID_MAX = $UID_MAX\n");
  # I suppose this is as good as it gets - 
  #   Usually user accounts have UID > 100 and 
  #   "system accounts" have UID < 100, but there is no guarantee   
  # that 
  #   this will hold for pseudo-users like "postgress" etc.
  # Also nobody is usually 99 on linux, but -1 on "standard" unices.
  # RedHat places the dividing line at 500. Others use 400...
  my @line;
  my $s = 0;

  while (<TMP>) {
    @line = split ':';
    if ($line[2] >= $UID_MIN && $line[2] <= $UID_MAX
    && !($line[0] eq 'nobody')) {
      $s++;
      $is_account{$line[0]} = 1;
    } else {
      $is_sys_account{$line[0]} = 1;
    }
  }

  return $s;
}

# }}}
# {{{ active_users

#
# This is kind of alpha, but please test it.
# It calculates the number of "active" users based on the "wtmp" entries
# unfortunately at least Mandrake 8 and 9 ship with non-world-read wtmp
# and non-set-uid last, so this does not work any more...
#
# RJ: Actually I think the best thing to do is to bury this code and be silent about it.
#
sub active_users {
  my $userslisted;

  for (qw(reboot wtmp runlevel)) {  # This sysaccounts shouldn't be counted. Who else?
    $is_sys_account{$_} = 1;
  }
  open( TMP, "/usr/bin/last 2>&1|");
  while (<TMP>) {
    chop;
    if (m!/var/log/wtmp: Permission denied!) { # RJ: ***Boom*** on every non-EN system
      &ErrorInfo("/usr/bin/last failed because /var/log/wtmp isn't readable\n");
      last;
    }
    last if(!$_);                            # RJ: quick hack to safe bad code from harm
    my @tmp  = split;
    my $name = $tmp[0];
    if ($is_sys_account{$name}) {
      # do nothing
    } elsif (defined $is_account{$name}) {
      $is_user{$name} = 1;
    } elsif (/^\s*$/) {                      # blank line - do nothing
    } elsif ($#tmp == 9) {                   # OK line, but unknown user
      $option{DEBUG} && do {
    if (!$userslisted) {
      print STDERR 'Know users are: ',
        join(' ', keys(%is_account)), "\n";
      $userslisted = 1;
    }
    print STDERR "Unknown user: $name\n";
      }
    } else {
      &DebugErr("Strange line: $_\n");
    }
  }
  close TMP;
  my $i = 0;
  for (sort keys %is_user) {
    $option{DEBUG} && printf "Active user %3d: %s\n", ++$i, $_;
  }
  &Debug("$i active users found.\n");

  return $i;
}

# }}}

# {{{ installcrontab

#
sub installcrontab {
  my $hour = int(rand(24));
  my $min  = int(rand(60));
  my $day  = int(rand(7));  # Weekday. This version runs once a week.
  my $cron = "";

  warn "Installing start of script into your crontab\n";
  if (open(CRON, "crontab -l |")) {
    &Debug("Checking crontab for machine-update\n");
    &Debug("Want to install as $progname\n");
    while (<CRON>) {
      if (/^#/ && $. <= 3) {    # initial comment
    &Debug("Skipping comment: $_");
    next;
      }
      if (/machine-update/) {
    if (/ $progname -m/) {
      die "Crontab entry already installed: $_\n";
    } else {
      die "Another entry with machine-update: $_\n";
    }
      }
      $cron .= $_;
    }
    close CRON;
    &Debug("Result from crontab -l: ", $? / 256, "\n");
    if ($? == 0) {
      &Debug("Crontab successfully read\n");
    } elsif ($? == 256) {
      warn "You don't seem to have a crontab. I will create one.\n";
    } else {
      die "Failed to read your crontab. Please report this as a bug: $?\n";
    }
  } else {
    &Debug("Result from crontab open(): $?\n");
    die "Unable to execute crontab command. Please check your system\n";
  }
  open(CRON, "|crontab -");
  print CRON $cron;
  print CRON "$min $hour * * $day $progname -m\n";
  close CRON;
  &Debug("Result from crontab: $?\n");
  if ($?) {
    die(<<EoF);
Installing new crontab failed.
YOUR CRONTAB MAY BE DAMAGED - use crontab -l to check it.
Here's its former content (if any):

$cron