diff -r 86504771a173 -r 3a18d3cd6ae6 log.pl --- a/log.pl Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,412 +0,0 @@ -#! /usr/bin/perl -# © 2009 Schlittermann - internet & unix support -# something about charsets -# * We assume the LOG file is always UTF-8! -# (I know, it's not true for historical entries, may be we can -# build some tool to convert the file line-by-line, or at least -# entry-by-entry -- and our database too. -# * The mail is sent always as UTF-8! -# * The current charset could be found using "langinfo CODESET" -# (hopefully - needs to be tested) -# Conclusion: -# - On opening/reading the log file: convert from UTF-8 -> current codeset -# - If this fails, issue a warning, use "head " to show the -# last LOG entry directly and then fire up the editor with an -# empty file (or just added notice why we do not show the old -# messages) -# - After editing: convert the current messsage from the current -# codeset to UTF-8 -# - The same is for message on command line (but this is more easy, we -# do not have to cope with the old message log - -use strict; -use warnings; -use File::Basename; -use File::Temp qw(tempfile); -use File::stat; -use File::Copy; -use Getopt::Long; -use Mail::Mailer; -use DBI; -use MIME::QuotedPrint; -use I18N::Langinfo qw(langinfo CODESET); -use Text::Iconv; -use Pod::Usage; -use Sys::Hostname; - -use Logbuch::HG; - -use lib "/etc/logbuch"; -use config; - - -# print @config::mailto, "\n"; - -#+-------+---------------+------+-----+---------+----------------+ -#| Field | Type | Null | Key | Default | Extra | -#+-------+---------------+------+-----+---------+----------------+ -#| id | int(11) | | MUL | NULL | auto_increment | -#| host | varchar(255) | YES | | NULL | | -#| date | datetime | YES | | NULL | | -#| user | varchar(255) | YES | | NULL | | -#| mailto| varchar(255) | YES | | NULL | | -#| text | text | YES | MUL | NULL | | -#| stamp | timestamp(14) | YES | | NULL | | -#+-------+---------------+------+-----+---------+----------------+ - -my $ME = basename $0; - -my $DSN = "DBI:mysql:logbuch:pu.schlittermann.de"; -my $USER = "logbuch"; -my $PW = "HIDDEN"; - -my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim"; -my $MAGIC = "#--- all changes below are ignored ---#\n"; -my $NODENAME = (split /\./, hostname)[0]; - -package config { - # default values if not set in the config file - our $db //= 1; - our $logfile //= "/root/LOG.$NODENAME"; -} - -my $opt_db = $config::db; -my $opt_mail = 1; -my $opt_message = ""; -my $opt_apt = ""; -my $opt_initdir = ""; -my $opt_file = $config::logfile; - -my $Dbh; - -sub identity(); -sub mailto(); -sub check_hg_bin(); -sub full_hostname(); -sub word_encoded($); - -MAIN: { - - GetOptions( - "db!" => \$opt_db, - "mail!" => \$opt_mail, - "m|message=s" => \$opt_message, - "type=s" => \$opt_apt, - "init-dir=s" => \$opt_initdir, - "f|file=s" => \$opt_file, - "help" => sub { pod2usage(-verbose => 0, -exit => 0) }, - "man" => sub { - pod2usage( - -verbose => 2, - -exit => 0, - -noperldoc => system("perldoc -V 2>/dev/null 1>/dev/null") - ); - }, - ) or pod2usage(); - - # override the HGUSER to the 'remote user' from our SSH connect - $ENV{HGUSER} = env_user() // $ENV{USER} // $ENV{LOGNAME} // getpwuid($>); - - if ($opt_message =~ /^@(.*)/) { - @ARGV = $1; - $opt_message = join "", <>; - } - elsif ($opt_message eq "-") { - $opt_message = join "", ; - } - elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) { - open(I, $2) or die "Can't open $2: $!\n"; - $opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n") . join "", map { - if (/^\d/) { ($_) } - elsif (/^(?:Inst|Conf|Remv|Purg)/) { ("- $_") } - else { () } - } ; - } - - if ($opt_message =~ /\n/) { - $opt_message =~ s/\n/\n /g; - } - - if (@config::notify_dirs || $opt_initdir) { - check_hg_bin(); - } - - if ($opt_initdir) { - - my $repo = Logbuch::HG->new(repo => $opt_initdir); - - $repo->is_repository() - and die "$ME: directory already initialized, skipping\n"; - - # any repository is likely to contain sensitive data somewhere - my $umask = umask 0077 - or die "$ME: Can't set umask: $!"; - - $repo->init() - or die "E: initialization failed\n"; - - umask $umask - or warn "$ME: Can't restore umask: $!"; - - $repo->addremove(); - $repo->commit("initial check in"); - - exit 0; - } - - my $hg_status_text = ""; - if (@config::notify_dirs) { - foreach my $dir (@config::notify_dirs) { - -d $dir or next; - - print "$ME: Checking $dir for modifications\n"; - - my $repo = Logbuch::HG->new(repo => $dir); - $repo->is_repository() - or die "$ME: directory $dir not initialized please call: \n", - " # $ME --init-dir $dir \n"; - - $repo->addremove(); - $hg_status_text .= $repo->status(); - } - } - - if ($opt_db) { - END { $Dbh->disconnect() if $Dbh; } - $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 0 }) - or warn $DBI::errstr; - } - - # Temporärfile öffnen - my ($fh, $file) = tempfile(DIR => "/tmp", UNLINK => 1); - - my $auto_message = - (not $hg_status_text) - ? "" - : "\n" - . " Modified config files since last log entry listend below...\n" - . $hg_status_text; - - # Kopftext eintragen - print $fh "Date: ", scalar(localtime()), "\n", - "User: ", identity(), "\n", - "MailTo: ", mailto(), "\n", - "\n", - " * $opt_message", - "\n", - $auto_message, - "\n", $MAGIC, "\n"; - - # LOG. wird in Zukunft genutzt und LOG nur ein Symlink - # dorthin - if ($opt_file =~ /(.*)\.$NODENAME$/ and !(-e $opt_file) and (-f $1)) { - rename($1 => $opt_file) or die "Can't rename $1 => $opt_file: !\n"; - symlink($opt_file, $1) or die "Can't symlink $1 => $opt_file: $!\n"; - } - - if (!-e $opt_file) { - open(X, $_ = ">>$opt_file") or die "Can't open $_: $!\n"; - close X; - } - - open(IN, $_ = $opt_file) or die "Can't open $_: $!\n"; - print $fh ; - close IN; - - if (!$opt_message) { - my $stamp = stat($file)->mtime(); - system($EDITOR, "+5", $file); - - if ($stamp == stat($file)->mtime()) { - print STDERR "Nothing changed. Discarding the note.\n"; - unlink $file; - exit 0; - } - } - - # Jetzt wie versprochen den (eventuell geänderten Rest) aus der - # Temp-Datei wegschneiden - { - my ($date, $user, $head, $text, $mailto); - my $pos; - - seek $fh, 0, 0; - for ($pos = tell $fh ; defined($_ = <$fh>) ; $pos = tell $fh) { - - $head .= "$_" if not $text and /^\S+:/; - - /^Date:\s+(.*)/ and $date = $1, next; - /^User:\s+(.*)/ and $user = $1, next; - /^MailTo:\s(.*)/ and $mailto = $1, next; - last if $_ eq $MAGIC; - - $text .= $_ - if /\S/ - || $text; # somit werden die ersten Leerzeilen übersprungen - } - - $text =~ s/\s*$//s; # Leerzeichen am Ende weg - - truncate $fh, $pos; - seek $fh, 0, 2; - - if ($opt_db and $Dbh) { - my $sth = $Dbh->prepare(" - INSERT INTO log (host, date, user, mailto, text) - VALUES(?, now(), ?, ?, ?)"); - $sth->execute(full_hostname(), $user, $mailto, $text); - print STDERR "Database entry inserted\n"; - } - - if ($opt_mail and $mailto) { - my $mailer = new Mail::Mailer "sendmail" - or die "Can't create Mailer: $!\n"; - - my $subject = (split /\n/, $text)[0]; - $subject =~ s/^\s*\S\s//; # cut the "itemizer" - - # and now convert to quoted printable (UTF-8) - # =?utf-8?q?St=C3=BCmper_am_Werk=3A_Shellscripte_aus_der?= - $subject = - word_encoded("Service [" . full_hostname() . "]: $subject"); - - $mailer->open( - { - "Content-Type" => "text/plain; charset=utf-8", - "Content-Transfer-Encoding" => "8bit", - "To" => $mailto, - "Subject" => $subject - } - ); - print $mailer $head, "\n", $text; - close $mailer; - print STDERR "Mail sent (to $mailto).\n"; - } - - if (@config::notify_dirs) { - foreach my $dir (@config::notify_dirs) { - -d $dir or next; - - my $repo = Logbuch::HG->new(repo => $dir); - $repo->commit(); - } - } - } - - # Und jetzt das aus der alten Datei dort anhängen - open(IN, $_ = $opt_file) or die "Can't open $_: $!\n"; - print $fh ; - close $fh; - close IN; - - move $file, $opt_file; - -} - -sub env_user { - foreach (qw(IUS_USER IUS_PROFILE REMOTE_USER)) { - return $ENV{$_} if length defined $ENV{$_}; - } - return undef; -} - -sub identity() { - my $user = `who am i`; - chomp $user; - $user .= " [" . (env_user() // '-') . "]"; - return $user; -} - -sub full_hostname() { - my $r = `hostname -f`; - chomp($r); - return $r; -} - -sub mailto() { - return join(", ", grep {defined} @config::mailto); -} - -sub word_encoded($) { - my $line = shift; - - # to get "Q" word encoding, we've to fix the result a bit - # http://en.wikipedia.org/wiki/MIME - # FIXME: The line may be longer than expected! - $line = encode_qp($line); - $line =~ s/([_?])/sprintf "=%02X", ord($1)/ige; - $line =~ s/[ \t]/_/g; - return join "\t", map { "=?UTF-8?Q?$_?=\n" } split /=\n/, $line; -} - -sub check_hg_bin() { - if (not Logbuch::HG::hg_available()) { - - die <<'EOF'; - -You requested an operation based on hg/mercurial but this tool is -not installed! - -Either you could change the configuration in /etc/lobbuch/config.pm and -remove lines starting with @notify_dirs, or you could simply install the -required packages: - - # aptitude install mercurial rcs - -Exiting! -EOF - } -} -__END__ - -=head1 NAME - - log -- log utility (ius) - -=head1 SYNOPSIS - - log [--[no]db] [--[no]mail] [--init-dir ] [--message ] [-f|--logfile ] - -=head1 DESCRIPTION - -This (ius) tool prepends a custom log message to a log file (typically -/root/LOG.). - -=head1 OPTIONS - -B: the defaults of some of these options may be changed through -a configuration file. - -=over - -=item B<--[no]db> - -(Don't) write the log messages into the specified database (default: on) - -=item B<--[no]mail> - -(Don't) send the log message as mail. (default: on) - -=item B<--init-dir> I - -Initialize the directory I with a VCS repository. When you've done -this, further changes to I will be logged too. - -=item B<--message> I - -The message to use. Otherwise an editor ($ENV{EDITOR}) is started. -If the message starts with a "@", it's considered to be a file. - -When the messages starts as "apt[:I]@I" it starts special -apt message processing. The default I is "APT: upgrade". -This text becomes the first line of the log message. - -=item B<-f>|B<--file> I - -The logfile to use. (default: F< /root/LOG.>) - -=back - -=cut - -# vim:sts=4 sw=4 aw ai sm: