log.pl
changeset 21 2404b9e58749
parent 16 bb1b17fee8c3
child 25 e8f1315b1617
equal deleted inserted replaced
20:2c0e6f2515cf 21:2404b9e58749
    11 		  to be a message FILE.
    11 		  to be a message FILE.
    12 		- message can be: apt[:text]\@<FILE> - this will
    12 		- message can be: apt[:text]\@<FILE> - this will
    13 		  start special file processing (assuming output
    13 		  start special file processing (assuming output
    14 		  from apt, with text (default: APT: upgrade) going
    14 		  from apt, with text (default: APT: upgrade) going
    15 		  to the first line)
    15 		  to the first line)
       
    16     --logfile=s	  use this(!) logfile
    16 #
    17 #
       
    18 # something about charsets
       
    19 # * We assume the LOG file is always UTF-8!
       
    20 #   (I know, it's not true for historical entries, may be we can
       
    21 #   build some tool to convert the file line-by-line, or at least
       
    22 #   entry-by-entry -- and our database too.
       
    23 # * The mail is sent always as UTF-8!
       
    24 # * The current charset could be found using "langinfo CODESET"
       
    25 #   (hopefully - needs to be tested)
       
    26 # Conclusion:
       
    27 #   - On opening/reading the log file: convert from UTF-8 -> current codeset
       
    28 #   - If this fails, issue a warning, use "head <something>" to show the
       
    29 #     last LOG entry directly and then fire up the editor with an 
       
    30 #     empty file (or just added notice why we do not show the old
       
    31 #     messages)
       
    32 #   - After editing: convert the current messsage to from the current
       
    33 #     codeset UTF-8
       
    34 #   - The same is for message on command line (but this is more easy, we
       
    35 #     do not have to cope with the old message log
       
    36 
    17 
    37 
    18 use strict;
    38 use strict;
    19 use warnings;
    39 use warnings;
    20 use File::Basename;
    40 use File::Basename;
    21 use File::Temp qw(tempfile);
    41 use File::Temp qw(tempfile);
    23 use File::Copy;
    43 use File::Copy;
    24 use Getopt::Long;
    44 use Getopt::Long;
    25 use Mail::Mailer;
    45 use Mail::Mailer;
    26 use DBI;
    46 use DBI;
    27 use MIME::QuotedPrint;
    47 use MIME::QuotedPrint;
       
    48 use I18N::Langinfo qw(langinfo CODESET);
       
    49 use Text::Iconv;
    28 
    50 
    29 use Logbuch::HG;
    51 use Logbuch::HG;
    30 
    52 
    31 use lib "/etc/logbuch";
    53 use lib "/etc/logbuch";
    32 use config;
    54 use config;
    45 #| stamp | timestamp(14) | YES  |     | NULL    |                |
    67 #| stamp | timestamp(14) | YES  |     | NULL    |                |
    46 #+-------+---------------+------+-----+---------+----------------+
    68 #+-------+---------------+------+-----+---------+----------------+
    47 
    69 
    48 my $ME = basename $0;
    70 my $ME = basename $0;
    49 
    71 
    50 my $DSN = "DBI:mysql:logbuch:pu.schlittermann.de";
    72 my $DSN  = "DBI:mysql:logbuch:pu.schlittermann.de";
    51 my $USER = "logbuch";
    73 my $USER = "logbuch";
    52 my $PW = "HIDDEN";
    74 my $PW   = "HIDDEN";
    53 
    75 
    54 my $LOG = "$ENV{HOME}/LOG";
       
    55 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
    76 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
    56 my $MAGIC = "#--- all changes below are ignored ---#\n";
    77 my $MAGIC = "#--- all changes below are ignored ---#\n";
    57 
    78 
    58 my $opt_db = 1;
    79 my $opt_db      = 1;
    59 my $opt_mail = 1;
    80 my $opt_mail    = 1;
    60 my $opt_message = "";
    81 my $opt_message = "";
    61 my $opt_apt = "";
    82 my $opt_apt     = "";
    62 my $opt_initdir = "";
    83 my $opt_initdir = "";
       
    84 my $opt_file    = "$ENV{HOME}/LOG";
    63 
    85 
    64 my $Dbh;
    86 my $Dbh;
    65 
    87 
    66 sub identity();
    88 sub identity();
    67 sub hostname();
    89 sub hostname();
    68 sub mailto();
    90 sub mailto();
    69 sub check_hg_bin();
    91 sub check_hg_bin();
    70 
    92 
    71 MAIN: {
    93 MAIN: {
    72 
    94 
    73     GetOptions("db!" => \$opt_db, 
    95     GetOptions(
    74 	"mail!" => \$opt_mail,
    96         "db!"        => \$opt_db,
    75 	"message=s" => \$opt_message,
    97         "mail!"      => \$opt_mail,
    76 	"type=s" => \$opt_apt,
    98         "message=s"  => \$opt_message,
    77 	"init-dir=s" => \$opt_initdir,
    99         "type=s"     => \$opt_apt,
       
   100         "init-dir=s" => \$opt_initdir,
       
   101         "file=s"     => \$opt_file,
    78     ) or die eval "\"$USAGE\"";
   102     ) or die eval "\"$USAGE\"";
    79 
   103 
    80     if ($opt_message =~ /^@(.*)/) {
   104     if ($opt_message =~ /^@(.*)/) {
    81 	@ARGV = $1;
   105         @ARGV = $1;
    82 	$opt_message = join "", <>;
   106         $opt_message = join "", <>;
    83     } elsif ($opt_message eq "-") {
   107     }
    84 	$opt_message = join "", <STDIN>;
   108     elsif ($opt_message eq "-") {
    85     } elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) {
   109         $opt_message = join "", <STDIN>;
    86 	open(I, $2) or die "Can't open $2: $!\n";
   110     }
    87 	$opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n")
   111     elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) {
    88 	    . join "", map { 
   112         open(I, $2) or die "Can't open $2: $!\n";
    89 		if (/^\d/) { ($_) }
   113         $opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n") . join "", map {
    90 		elsif ( /^(?:Inst|Conf|Remv|Purg)/ ) { ("- $_") }
   114             if    (/^\d/)                      { ($_) }
    91 		else { () } 
   115             elsif (/^(?:Inst|Conf|Remv|Purg)/) { ("- $_") }
    92 	    } <I>;
   116             else                               { () }
       
   117         } <I>;
    93     }
   118     }
    94 
   119 
    95     if ($opt_message =~ /\n/) {
   120     if ($opt_message =~ /\n/) {
    96 	$opt_message =~ s/\n/\n    /g;
   121         $opt_message =~ s/\n/\n    /g;
    97     }
   122     }
    98 
   123 
    99     if (defined @config::notify_dirs || $opt_initdir) {
   124     if (defined @config::notify_dirs || $opt_initdir) {
   100 	check_hg_bin();
   125         check_hg_bin();
   101     }
   126     }
   102 
   127 
   103     if ($opt_initdir) {
   128     if ($opt_initdir) {
   104 	my $repo = Logbuch::HG->new( repo => $opt_initdir );
   129         my $repo = Logbuch::HG->new(repo => $opt_initdir);
   105 
   130 
   106 	$repo->is_repository() and
   131         $repo->is_repository()
   107 	    die "$ME: directory already initialized, skipping\n";
   132           and die "$ME: directory already initialized, skipping\n";
   108 
   133 
   109 	$repo->init() or
   134         $repo->init()
   110 	    die "E: initialization failed\n";
   135           or die "E: initialization failed\n";
   111 	
   136 
   112 	$repo->addremove();
   137         $repo->addremove();
   113 	$repo->commit("initial check in");
   138         $repo->commit("initial check in");
   114 
   139 
   115 	exit 0;
   140         exit 0;
   116     }
   141     }
   117 
   142 
   118     my $hg_status_text = "";
   143     my $hg_status_text = "";
   119     if (defined @config::notify_dirs) {
   144     if (defined @config::notify_dirs) {
   120 	foreach my $dir (@config::notify_dirs) {
   145         foreach my $dir (@config::notify_dirs) {
   121 	    -d $dir or next;
   146             -d $dir or next;
   122 
   147 
   123 	    print "$ME: Checking $dir for modifications\n";
   148             print "$ME: Checking $dir for modifications\n";
   124 
   149 
   125 	    my $repo = Logbuch::HG->new( repo => $dir );
   150             my $repo = Logbuch::HG->new(repo => $dir);
   126 	    $repo->is_repository() or
   151             $repo->is_repository()
   127 		die "$ME: directory $dir not initialized please call: \n",
   152               or die "$ME: directory $dir not initialized please call: \n",
   128 		    "  # $ME --init-dir $dir \n";
   153               "  # $ME --init-dir $dir \n";
   129 
   154 
   130 	    $repo->addremove();
   155             $repo->addremove();
   131 	    $hg_status_text .= $repo->status();
   156             $hg_status_text .= $repo->status();
   132 	}
   157         }
   133     }
   158     }
   134 
   159 
   135     if ($opt_db) {
   160     if ($opt_db) {
   136 	$Dbh = DBI->connect($DSN, $USER, $PW, {RaiseError => 1})
   161         $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 1 })
   137 	    or die $DBI::errstr;
   162           or die $DBI::errstr;
   138 	END { $Dbh->disconnect() if $Dbh; }
   163         END { $Dbh->disconnect() if $Dbh; }
   139     }
   164     }
   140 
   165 
   141     # Temporärfile öffnen
   166     # Temporärfile öffnen
   142     my ($fh, $file);
   167     my ($fh, $file) = tempfile(DIR => "/tmp", UNLINK => 1);
   143     END { unlink $file if $file; }
   168 
   144     ($fh, $file) = tempfile(DIR => "/tmp");
   169     my $auto_message =
   145 
   170       (not $hg_status_text)
   146     my $auto_message = (not $hg_status_text) ? "" :
   171       ? ""
   147 	"\n"
   172       : "\n"
   148 	. " Modified config files since last log entry listend below...\n"
   173       . " Modified config files since last log entry listend below...\n"
   149 	. $hg_status_text
   174       . $hg_status_text . "\n";
   150 	. "\n";
       
   151 
   175 
   152     # Kopftext eintragen
   176     # Kopftext eintragen
   153     print $fh 
   177     print $fh "Date: ", scalar(localtime()), "\n",
   154 	    "Date: ", scalar(localtime()), "\n",
   178       "User: ",   identity(), "\n",
   155 	    "User: ", identity(), "\n",
   179       "MailTo: ", mailto(),   "\n",
   156 	    "MailTo: ", mailto(), "\n",
   180       "\n",
   157 	    "\n",
   181       "  * $opt_message",
   158 	    "  * $opt_message",
   182       "\n",
   159 	    "\n",
   183       $auto_message,
   160 	    $auto_message,
   184       "\n", $MAGIC, "\n";
   161 	    "\n", $MAGIC, "\n";
   185 
   162 
   186     if (!-e $opt_file) {
   163     if (!-e $LOG) {
   187         open(X, $_ = ">>$opt_file") or die "Can't open $_: $!\n";
   164 	open(X, $_ = ">>$LOG") or die "Can't open $_: $!\n";
   188         close X;
   165 	close X;
   189     }
   166     };
   190 
   167 
   191     open(IN, $_ = $opt_file) or die "Can't open $_: $!\n";
   168     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
       
   169     print $fh <IN>;
   192     print $fh <IN>;
   170     close IN;
   193     close IN;
   171 
   194 
   172     if (!$opt_message) {
   195     if (!$opt_message) {
   173 	my $stamp = stat($file)->mtime();
   196         my $stamp = stat($file)->mtime();
   174 	system($EDITOR, "+5", $file);
   197         system($EDITOR, "+5", $file);
   175     
   198 
   176 	if ($stamp == stat($file)->mtime()) {
   199         if ($stamp == stat($file)->mtime()) {
   177 	    print STDERR "Nothing changed.  Discarding the note.\n";
   200             print STDERR "Nothing changed.  Discarding the note.\n";
   178 	    unlink $file;
   201             unlink $file;
   179 	    exit 0;
   202             exit 0;
   180 	}
   203         }
   181     }
   204     }
   182 
   205 
   183     # Jetzt wie versprochen den (eventuell geänderten Rest) aus der
   206     # Jetzt wie versprochen den (eventuell geänderten Rest) aus der
   184     # Temp-Datei wegschneiden
   207     # Temp-Datei wegschneiden
   185     {
   208     {
   186 	my ($date, $user, $head, $text, $mailto);
   209         my ($date, $user, $head, $text, $mailto);
   187 	my $pos;
   210         my $pos;
   188 
   211 
   189 	seek $fh, 0, 0;
   212         seek $fh, 0, 0;
   190 	for($pos = tell $fh; defined($_ = <$fh>); $pos = tell $fh) {
   213         for ($pos = tell $fh ; defined($_ = <$fh>) ; $pos = tell $fh) {
   191 
   214 
   192 	    $head .= "$_" if not $text and /^\S+:/;
   215             $head .= "$_" if not $text and /^\S+:/;
   193 
   216 
   194 	    /^Date:\s+(.*)/ and $date = $1, next;
   217             /^Date:\s+(.*)/  and $date   = $1, next;
   195 	    /^User:\s+(.*)/ and $user = $1, next;
   218             /^User:\s+(.*)/  and $user   = $1, next;
   196 	    /^MailTo:\s(.*)/ and $mailto = $1, next;
   219             /^MailTo:\s(.*)/ and $mailto = $1, next;
   197 	    last if $_ eq $MAGIC;
   220             last if $_ eq $MAGIC;
   198 
   221 
   199 	    $text .= $_ if /\S/ || $text;   # somit werden die ersten Leerzeilen übersprungen
   222             $text .= $_
   200 	}
   223               if /\S/
   201 
   224                   || $text;   # somit werden die ersten Leerzeilen übersprungen
   202 	$text  =~ s/\s*$//s; # Leerzeichen am Ende weg
   225         }
   203 
   226 
   204 	truncate $fh, $pos;
   227         $text =~ s/\s*$//s;    # Leerzeichen am Ende weg
   205 	seek $fh, 0, 2;
   228 
   206 
   229         truncate $fh, $pos;
   207 	if ($opt_db) {
   230         seek $fh, 0, 2;
   208 	    my $sth = $Dbh->prepare("
   231 
       
   232         if ($opt_db) {
       
   233             my $sth = $Dbh->prepare("
   209 		    INSERT INTO log (host, date, user, mailto, text)
   234 		    INSERT INTO log (host, date, user, mailto, text)
   210 		    VALUES(?, now(), ?, ?, ?)");
   235 		    VALUES(?, now(), ?, ?, ?)");
   211 	    $sth->execute(hostname(), $user, $mailto, $text);
   236             $sth->execute(hostname(), $user, $mailto, $text);
   212 	    print STDERR "Database entry inserted\n";
   237             print STDERR "Database entry inserted\n";
   213 	}
   238         }
   214 
   239 
   215 	if ($opt_mail and $mailto) {
   240         if ($opt_mail and $mailto) {
   216 	    my $mailer = new Mail::Mailer "sendmail"
   241             my $mailer = new Mail::Mailer "sendmail"
   217 		or die "Can't create Mailer: $!\n";
   242               or die "Can't create Mailer: $!\n";
   218 
   243 
   219 	    my $subject = (split /\n/, $text)[0];
   244             my $subject = (split /\n/, $text)[0];
   220 	    $subject =~ s/^\s*\S\s//;	# cut the "itemizer"
   245             $subject =~ s/^\s*\S\s//;    # cut the "itemizer"
   221 	    $subject = encode_qp("Service [". hostname(). "]: $subject\n");
   246             $subject = encode_qp("Service [" . hostname() . "]: $subject\n");
   222 	    $subject =~ s/\n(.)/\n\t$1/g;
   247             $subject =~ s/\n(.)/\n\t$1/g;
   223 
   248 
   224 	    $mailer->open({
   249             $mailer->open(
   225 		"Content-Type" => "text/plain; charset=utf-8",
   250                 {
   226 		"Content-Transfer-Encoding" => "8bit",
   251                     "Content-Type"              => "text/plain; charset=utf-8",
   227 		"To" => $mailto,
   252                     "Content-Transfer-Encoding" => "8bit",
   228 		"Subject" => $subject});
   253                     "To"                        => $mailto,
   229 	    print $mailer $head, "\n", $text;
   254                     "Subject"                   => $subject
   230 	    close $mailer;
   255                 }
   231 	    print STDERR "Mail sent (to $mailto).\n";
   256             );
   232 	}
   257             print $mailer $head, "\n", $text;
   233 
   258             close $mailer;
   234 	if (defined @config::notify_dirs) {
   259             print STDERR "Mail sent (to $mailto).\n";
   235 	    foreach my $dir (@config::notify_dirs) {
   260         }
   236 		-d $dir or next;
   261 
   237 
   262         if (defined @config::notify_dirs) {
   238 		my $repo = Logbuch::HG->new( repo => $dir );
   263             foreach my $dir (@config::notify_dirs) {
   239 		$repo->commit();
   264                 -d $dir or next;
   240 	    }
   265 
   241 	}
   266                 my $repo = Logbuch::HG->new(repo => $dir);
       
   267                 $repo->commit();
       
   268             }
       
   269         }
   242     }
   270     }
   243 
   271 
   244     # Und jetzt das aus der alten Datei dort anhängen
   272     # Und jetzt das aus der alten Datei dort anhängen
   245     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
   273     open(IN, $_ = $opt_file) or die "Can't open $_: $!\n";
   246     print $fh <IN>;
   274     print $fh <IN>;
   247     close $fh;
   275     close $fh;
   248     close IN;
   276     close IN;
   249 
   277 
   250     move $file, $LOG;
   278     move $file, $opt_file;
   251 
   279 
   252 }
   280 }
   253 
   281 
   254 sub identity()
   282 sub identity() {
   255 {
       
   256     my $user = `who am i`;
   283     my $user = `who am i`;
   257     chomp $user;
   284     chomp $user;
   258     $user .= " [" . ($ENV{IUS_PROFILE} || $ENV{REMOTE_USER} || "-") . "]";
   285     $user .= " [" . ($ENV{IUS_PROFILE} || $ENV{REMOTE_USER} || "-") . "]";
   259     return $user;
   286     return $user;
   260 }
   287 }
   261 
   288 
   262 sub hostname()
   289 sub hostname() {
   263 {
       
   264     my $r = `hostname -f`;
   290     my $r = `hostname -f`;
   265     chomp($r);
   291     chomp($r);
   266     return $r;
   292     return $r;
   267 }
   293 }
   268 
   294 
   269 sub mailto()
   295 sub mailto() {
   270 {
       
   271     return join(", ", @config::mailto);
   296     return join(", ", @config::mailto);
   272 }
   297 }
   273 
   298 
   274 
   299 sub check_hg_bin() {
   275 sub check_hg_bin()
       
   276 {
       
   277     if (not Logbuch::HG::hg_available()) {
   300     if (not Logbuch::HG::hg_available()) {
   278 
   301 
   279 	die <<'EOF';
   302         die <<'EOF';
   280 
   303 
   281 You requested an operation based on hg/mercurial but this tool is 
   304 You requested an operation based on hg/mercurial but this tool is 
   282 not installed!
   305 not installed!
   283 
   306 
   284 Either you could change the configuration in /etc/lobbuch/config.pm and
   307 Either you could change the configuration in /etc/lobbuch/config.pm and
   290 Exiting!
   313 Exiting!
   291 EOF
   314 EOF
   292     }
   315     }
   293 }
   316 }
   294 
   317 
   295 
       
   296 # vim:sts=4 sw=4 aw ai sm:
   318 # vim:sts=4 sw=4 aw ai sm:
   297 
   319