--- 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 <something>" 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 "", <STDIN>;
- }
- 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 { () }
- } <I>;
- }
-
- 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.<hostname> 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 <IN>;
- 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 <IN>;
- 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 <dir>] [--message <msg>] [-f|--logfile <file>]
-
-=head1 DESCRIPTION
-
-This (ius) tool prepends a custom log message to a log file (typically
-/root/LOG.<hostname>).
-
-=head1 OPTIONS
-
-B<Beware>: 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<dir>
-
-Initialize the directory I<dir> with a VCS repository. When you've done
-this, further changes to I<dir> will be logged too.
-
-=item B<--message> I<msg>
-
-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<text>]@I<FILE>" it starts special
-apt message processing. The default I<text> is "APT: upgrade".
-This text becomes the first line of the log message.
-
-=item B<-f>|B<--file> I<file>
-
-The logfile to use. (default: F< /root/LOG.<NODENAME>>)
-
-=back
-
-=cut
-
-# vim:sts=4 sw=4 aw ai sm: