#!/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.31'; our $CVS_VERSION = '$Revision: 1.9 $ $Date: 2008/01/05 15:03:50 $ $Author: patrick $'; our $IsInTestHarness; use vars qw(%values %oldvalues $errordata $debugdata %files); # data that is sent use vars qw($progname %option $mailprogram); 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" # Find out what mail program to use !! Terrible kludge !! $mailprogram = "/usr/bin/mail"; if (! -x "$mailprogram") { if (-x "/bin/mail") { $mailprogram = "/bin/mail"; } else { if (-x "/bin/mailx") { $mailprogram = "/bin/mailx"; } else { if (-x "/usr/sbin/sendmail") { $mailprogram = "/usr/sbin/sendmail"; } else { if (-x "/usr/lib/sendmail") { $mailprogram = "/usr/lib/sendmail"; } else { if (-x "/usr/bin/mutt") { $mailprogram = "/usr/bin/mutt"; } else { if (-x "/usr/sbin/exim4") { $mailprogram = "/usr/sbin/exim4"; } else { if (-x "/usr/bin/elm") { $mailprogram = "/usr/bin/elm"; } else { die "Cannot find a mail program to use"; } } } } } } } } } # }}} # {{{ 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 = ; 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 () { 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, "|$mailprogram machine-registration\@counter.li.org") || die "Unable to open $mailprogram\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 < 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: # 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 # 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" || 0; 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," /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 # 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 () { 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 () { @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 () { 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 () { 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(<) { if (/^#/ && $. <= 3) { # initial comment &Debug("Skipping comment: $_"); next; } if (/machine-update/) { if (/ $progname -m/) { print STDERR "Crontab entry found and removed\n"; $found = 1; next; # skip stuff at end.... } else { die "Another entry with machine-update: $_\nUninstall manually?\n"; } } $cron .= $_; } close CRON; &Debug("Result from crontab -l: $?\n"); if ($?) { die "Failed to read your crontab. You may not have one?\n"; } if ($found) { open(CRON, "|crontab -"); print CRON $cron; close CRON; &Debug("Result from crontab: $?\n"); if ($?) { die(</dev/null`; # determine binarys full path chomp $bin; return $bin if(-x $bin); # if there and executable: all is well - return it if(!$bin) { # if not there &Debug("No $bin found\n"); # state so } else { # there but not executable &Debug("$bin found, but not executable\n"); } return ''; # so return an empty string (binary will not exec) } # }}} # {{{ getval_from_file get value from system file @ row,col # sub getval_from_file { my $file = shift; my $row = shift; my $col = shift; my @file; my @cols; if (!(-r $file)) { &DebugErr("File $file not readable\n"); return ''; } sysopen(FH,$file, O_RDONLY); @file = ; # read whole file to array close FH; @cols = split /\s+/, $file[$row]; # get the right row return $cols[$col]; # return the right column } # }}} sub addonefileforsending { my $file = shift; my @file; if (!(-r $file)) { &DebugErr("File $file not readable\n"); return ''; } sysopen(FH,$file, O_RDONLY); @file = ; # read whole file to array close FH; $files{$file} = join('', @file); } # {{{ Debug print debug information if flag is set # sub Debug { $option{DEBUG} && print @_; } # }}} # {{{ DebugErr print debug on STDERR if flag is set # sub DebugErr { $option{DEBUG} && print STDERR @_; } # }}} # {{{ ErrorInfo sub ErrorInfo { $errordata .= join('', @_); } # }}} # {{{ DebugInfo sub DebugInfo { $option{info} && ($debugdata .= join('', @_)); } # }}} # {{{ help print help & exit # sub help { my $host = `uname -n`; print <960MB capable # - slightly better randomness # # Changelog 0.21 # - added attaching of files # - added fetching of uptime_1 and uptime_2 # # Changelog 0.22 # - removed "manual" copying of entries # - added suppressing error messages from "xbin" calling "which" # - suppressed NFS from "df -T" listing # # Changelog 0.23 # - added sending /proc/pci # - removed client-side parsing of DF output and uptime # # Changelog 0.24 # - added sending /proc/version (inspired by klive) # - changed fetching of old data from "all" to "needed" # - removed CPU-parsing code # - fixed warning (harmless) from crontab creation # - added sending /proc/bus/usb/devices # # Changelog 0.25 # - added sending size of /proc/kcore # - removed computation of memory client-side # # Changelog 0.26 # - adding cron entry no longer removes comments from crontab. # Crontab is not ours, so hands off. # # Changelog 0.27 # - When /proc/kcore does not exist on a system, its size is now zero # # Changelog 0.28 # - Added a terrible way to find out what email program can be used to send out the mail # # Changelog 0.29 # - Extended the hardcoded list of programs that can be used to send the # machine-update email # # Changelog 0.30 # - The script now sends us the version of perl used to run the script # We need this to solve some problems due to changes in between perl # versions # #vim:ts=8:sw=4:sts=4