log.pl
changeset 19 3a86e78a18b1
parent 16 bb1b17fee8c3
child 25 e8f1315b1617
equal deleted inserted replaced
18:9032fd09c274 19:3a86e78a18b1
    45 #| stamp | timestamp(14) | YES  |     | NULL    |                |
    45 #| stamp | timestamp(14) | YES  |     | NULL    |                |
    46 #+-------+---------------+------+-----+---------+----------------+
    46 #+-------+---------------+------+-----+---------+----------------+
    47 
    47 
    48 my $ME = basename $0;
    48 my $ME = basename $0;
    49 
    49 
    50 my $DSN = "DBI:mysql:logbuch:pu.schlittermann.de";
    50 my $DSN  = "DBI:mysql:logbuch:pu.schlittermann.de";
    51 my $USER = "logbuch";
    51 my $USER = "logbuch";
    52 my $PW = "HIDDEN";
    52 my $PW   = "HIDDEN";
    53 
    53 
    54 my $LOG = "$ENV{HOME}/LOG";
    54 my $LOG    = "$ENV{HOME}/LOG";
    55 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
    55 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
    56 my $MAGIC = "#--- all changes below are ignored ---#\n";
    56 my $MAGIC  = "#--- all changes below are ignored ---#\n";
    57 
    57 
    58 my $opt_db = 1;
    58 my $opt_db      = 1;
    59 my $opt_mail = 1;
    59 my $opt_mail    = 1;
    60 my $opt_message = "";
    60 my $opt_message = "";
    61 my $opt_apt = "";
    61 my $opt_apt     = "";
    62 my $opt_initdir = "";
    62 my $opt_initdir = "";
    63 
    63 
    64 my $Dbh;
    64 my $Dbh;
    65 
    65 
    66 sub identity();
    66 sub identity();
    68 sub mailto();
    68 sub mailto();
    69 sub check_hg_bin();
    69 sub check_hg_bin();
    70 
    70 
    71 MAIN: {
    71 MAIN: {
    72 
    72 
    73     GetOptions("db!" => \$opt_db, 
    73     GetOptions(
    74 	"mail!" => \$opt_mail,
    74         "db!"        => \$opt_db,
    75 	"message=s" => \$opt_message,
    75         "mail!"      => \$opt_mail,
    76 	"type=s" => \$opt_apt,
    76         "message=s"  => \$opt_message,
    77 	"init-dir=s" => \$opt_initdir,
    77         "type=s"     => \$opt_apt,
       
    78         "init-dir=s" => \$opt_initdir,
    78     ) or die eval "\"$USAGE\"";
    79     ) or die eval "\"$USAGE\"";
    79 
    80 
    80     if ($opt_message =~ /^@(.*)/) {
    81     if ($opt_message =~ /^@(.*)/) {
    81 	@ARGV = $1;
    82         @ARGV = $1;
    82 	$opt_message = join "", <>;
    83         $opt_message = join "", <>;
    83     } elsif ($opt_message eq "-") {
    84     }
    84 	$opt_message = join "", <STDIN>;
    85     elsif ($opt_message eq "-") {
    85     } elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) {
    86         $opt_message = join "", <STDIN>;
    86 	open(I, $2) or die "Can't open $2: $!\n";
    87     }
    87 	$opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n")
    88     elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) {
    88 	    . join "", map { 
    89         open(I, $2) or die "Can't open $2: $!\n";
    89 		if (/^\d/) { ($_) }
    90         $opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n") . join "", map {
    90 		elsif ( /^(?:Inst|Conf|Remv|Purg)/ ) { ("- $_") }
    91             if    (/^\d/)                      { ($_) }
    91 		else { () } 
    92             elsif (/^(?:Inst|Conf|Remv|Purg)/) { ("- $_") }
    92 	    } <I>;
    93             else                               { () }
       
    94         } <I>;
    93     }
    95     }
    94 
    96 
    95     if ($opt_message =~ /\n/) {
    97     if ($opt_message =~ /\n/) {
    96 	$opt_message =~ s/\n/\n    /g;
    98         $opt_message =~ s/\n/\n    /g;
    97     }
    99     }
    98 
   100 
    99     if (defined @config::notify_dirs || $opt_initdir) {
   101     if (defined @config::notify_dirs || $opt_initdir) {
   100 	check_hg_bin();
   102         check_hg_bin();
   101     }
   103     }
   102 
   104 
   103     if ($opt_initdir) {
   105     if ($opt_initdir) {
   104 	my $repo = Logbuch::HG->new( repo => $opt_initdir );
   106         my $repo = Logbuch::HG->new(repo => $opt_initdir);
   105 
   107 
   106 	$repo->is_repository() and
   108         $repo->is_repository()
   107 	    die "$ME: directory already initialized, skipping\n";
   109           and die "$ME: directory already initialized, skipping\n";
   108 
   110 
   109 	$repo->init() or
   111         $repo->init()
   110 	    die "E: initialization failed\n";
   112           or die "E: initialization failed\n";
   111 	
   113 
   112 	$repo->addremove();
   114         $repo->addremove();
   113 	$repo->commit("initial check in");
   115         $repo->commit("initial check in");
   114 
   116 
   115 	exit 0;
   117         exit 0;
   116     }
   118     }
   117 
   119 
   118     my $hg_status_text = "";
   120     my $hg_status_text = "";
   119     if (defined @config::notify_dirs) {
   121     if (defined @config::notify_dirs) {
   120 	foreach my $dir (@config::notify_dirs) {
   122         foreach my $dir (@config::notify_dirs) {
   121 	    -d $dir or next;
   123             -d $dir or next;
   122 
   124 
   123 	    print "$ME: Checking $dir for modifications\n";
   125             print "$ME: Checking $dir for modifications\n";
   124 
   126 
   125 	    my $repo = Logbuch::HG->new( repo => $dir );
   127             my $repo = Logbuch::HG->new(repo => $dir);
   126 	    $repo->is_repository() or
   128             $repo->is_repository()
   127 		die "$ME: directory $dir not initialized please call: \n",
   129               or die "$ME: directory $dir not initialized please call: \n",
   128 		    "  # $ME --init-dir $dir \n";
   130               "  # $ME --init-dir $dir \n";
   129 
   131 
   130 	    $repo->addremove();
   132             $repo->addremove();
   131 	    $hg_status_text .= $repo->status();
   133             $hg_status_text .= $repo->status();
   132 	}
   134         }
   133     }
   135     }
   134 
   136 
   135     if ($opt_db) {
   137     if ($opt_db) {
   136 	$Dbh = DBI->connect($DSN, $USER, $PW, {RaiseError => 1})
   138         $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 1 })
   137 	    or die $DBI::errstr;
   139           or die $DBI::errstr;
   138 	END { $Dbh->disconnect() if $Dbh; }
   140         END { $Dbh->disconnect() if $Dbh; }
   139     }
   141     }
   140 
   142 
   141     # Temporärfile öffnen
   143     # Temporärfile öffnen
   142     my ($fh, $file);
   144     my ($fh, $file);
   143     END { unlink $file if $file; }
   145     END { unlink $file if $file; }
   144     ($fh, $file) = tempfile(DIR => "/tmp");
   146     ($fh, $file) = tempfile(DIR => "/tmp");
   145 
   147 
   146     my $auto_message = (not $hg_status_text) ? "" :
   148     my $auto_message =
   147 	"\n"
   149       (not $hg_status_text)
   148 	. " Modified config files since last log entry listend below...\n"
   150       ? ""
   149 	. $hg_status_text
   151       : "\n"
   150 	. "\n";
   152       . " Modified config files since last log entry listend below...\n"
       
   153       . $hg_status_text . "\n";
   151 
   154 
   152     # Kopftext eintragen
   155     # Kopftext eintragen
   153     print $fh 
   156     print $fh "Date: ", scalar(localtime()), "\n",
   154 	    "Date: ", scalar(localtime()), "\n",
   157       "User: ",   identity(), "\n",
   155 	    "User: ", identity(), "\n",
   158       "MailTo: ", mailto(),   "\n",
   156 	    "MailTo: ", mailto(), "\n",
   159       "\n",
   157 	    "\n",
   160       "  * $opt_message",
   158 	    "  * $opt_message",
   161       "\n",
   159 	    "\n",
   162       $auto_message,
   160 	    $auto_message,
   163       "\n", $MAGIC, "\n";
   161 	    "\n", $MAGIC, "\n";
       
   162 
   164 
   163     if (!-e $LOG) {
   165     if (!-e $LOG) {
   164 	open(X, $_ = ">>$LOG") or die "Can't open $_: $!\n";
   166         open(X, $_ = ">>$LOG") or die "Can't open $_: $!\n";
   165 	close X;
   167         close X;
   166     };
   168     }
   167 
   169 
   168     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
   170     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
   169     print $fh <IN>;
   171     print $fh <IN>;
   170     close IN;
   172     close IN;
   171 
   173 
   172     if (!$opt_message) {
   174     if (!$opt_message) {
   173 	my $stamp = stat($file)->mtime();
   175         my $stamp = stat($file)->mtime();
   174 	system($EDITOR, "+5", $file);
   176         system($EDITOR, "+5", $file);
   175     
   177 
   176 	if ($stamp == stat($file)->mtime()) {
   178         if ($stamp == stat($file)->mtime()) {
   177 	    print STDERR "Nothing changed.  Discarding the note.\n";
   179             print STDERR "Nothing changed.  Discarding the note.\n";
   178 	    unlink $file;
   180             unlink $file;
   179 	    exit 0;
   181             exit 0;
   180 	}
   182         }
   181     }
   183     }
   182 
   184 
   183     # Jetzt wie versprochen den (eventuell geänderten Rest) aus der
   185     # Jetzt wie versprochen den (eventuell geänderten Rest) aus der
   184     # Temp-Datei wegschneiden
   186     # Temp-Datei wegschneiden
   185     {
   187     {
   186 	my ($date, $user, $head, $text, $mailto);
   188         my ($date, $user, $head, $text, $mailto);
   187 	my $pos;
   189         my $pos;
   188 
   190 
   189 	seek $fh, 0, 0;
   191         seek $fh, 0, 0;
   190 	for($pos = tell $fh; defined($_ = <$fh>); $pos = tell $fh) {
   192         for ($pos = tell $fh ; defined($_ = <$fh>) ; $pos = tell $fh) {
   191 
   193 
   192 	    $head .= "$_" if not $text and /^\S+:/;
   194             $head .= "$_" if not $text and /^\S+:/;
   193 
   195 
   194 	    /^Date:\s+(.*)/ and $date = $1, next;
   196             /^Date:\s+(.*)/  and $date   = $1, next;
   195 	    /^User:\s+(.*)/ and $user = $1, next;
   197             /^User:\s+(.*)/  and $user   = $1, next;
   196 	    /^MailTo:\s(.*)/ and $mailto = $1, next;
   198             /^MailTo:\s(.*)/ and $mailto = $1, next;
   197 	    last if $_ eq $MAGIC;
   199             last if $_ eq $MAGIC;
   198 
   200 
   199 	    $text .= $_ if /\S/ || $text;   # somit werden die ersten Leerzeilen übersprungen
   201             $text .= $_
   200 	}
   202               if /\S/
   201 
   203                   || $text;   # somit werden die ersten Leerzeilen übersprungen
   202 	$text  =~ s/\s*$//s; # Leerzeichen am Ende weg
   204         }
   203 
   205 
   204 	truncate $fh, $pos;
   206         $text =~ s/\s*$//s;    # Leerzeichen am Ende weg
   205 	seek $fh, 0, 2;
   207 
   206 
   208         truncate $fh, $pos;
   207 	if ($opt_db) {
   209         seek $fh, 0, 2;
   208 	    my $sth = $Dbh->prepare("
   210 
       
   211         if ($opt_db) {
       
   212             my $sth = $Dbh->prepare("
   209 		    INSERT INTO log (host, date, user, mailto, text)
   213 		    INSERT INTO log (host, date, user, mailto, text)
   210 		    VALUES(?, now(), ?, ?, ?)");
   214 		    VALUES(?, now(), ?, ?, ?)");
   211 	    $sth->execute(hostname(), $user, $mailto, $text);
   215             $sth->execute(hostname(), $user, $mailto, $text);
   212 	    print STDERR "Database entry inserted\n";
   216             print STDERR "Database entry inserted\n";
   213 	}
   217         }
   214 
   218 
   215 	if ($opt_mail and $mailto) {
   219         if ($opt_mail and $mailto) {
   216 	    my $mailer = new Mail::Mailer "sendmail"
   220             my $mailer = new Mail::Mailer "sendmail"
   217 		or die "Can't create Mailer: $!\n";
   221               or die "Can't create Mailer: $!\n";
   218 
   222 
   219 	    my $subject = (split /\n/, $text)[0];
   223             my $subject = (split /\n/, $text)[0];
   220 	    $subject =~ s/^\s*\S\s//;	# cut the "itemizer"
   224             $subject =~ s/^\s*\S\s//;    # cut the "itemizer"
   221 	    $subject = encode_qp("Service [". hostname(). "]: $subject\n");
   225             $subject = encode_qp("Service [" . hostname() . "]: $subject\n");
   222 	    $subject =~ s/\n(.)/\n\t$1/g;
   226             $subject =~ s/\n(.)/\n\t$1/g;
   223 
   227 
   224 	    $mailer->open({
   228             $mailer->open(
   225 		"Content-Type" => "text/plain; charset=utf-8",
   229                 {
   226 		"Content-Transfer-Encoding" => "8bit",
   230                     "Content-Type"              => "text/plain; charset=utf-8",
   227 		"To" => $mailto,
   231                     "Content-Transfer-Encoding" => "8bit",
   228 		"Subject" => $subject});
   232                     "To"                        => $mailto,
   229 	    print $mailer $head, "\n", $text;
   233                     "Subject"                   => $subject
   230 	    close $mailer;
   234                 }
   231 	    print STDERR "Mail sent (to $mailto).\n";
   235             );
   232 	}
   236             print $mailer $head, "\n", $text;
   233 
   237             close $mailer;
   234 	if (defined @config::notify_dirs) {
   238             print STDERR "Mail sent (to $mailto).\n";
   235 	    foreach my $dir (@config::notify_dirs) {
   239         }
   236 		-d $dir or next;
   240 
   237 
   241         if (defined @config::notify_dirs) {
   238 		my $repo = Logbuch::HG->new( repo => $dir );
   242             foreach my $dir (@config::notify_dirs) {
   239 		$repo->commit();
   243                 -d $dir or next;
   240 	    }
   244 
   241 	}
   245                 my $repo = Logbuch::HG->new(repo => $dir);
       
   246                 $repo->commit();
       
   247             }
       
   248         }
   242     }
   249     }
   243 
   250 
   244     # Und jetzt das aus der alten Datei dort anhängen
   251     # Und jetzt das aus der alten Datei dort anhängen
   245     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
   252     open(IN, $_ = $LOG) or die "Can't open $_: $!\n";
   246     print $fh <IN>;
   253     print $fh <IN>;
   249 
   256 
   250     move $file, $LOG;
   257     move $file, $LOG;
   251 
   258 
   252 }
   259 }
   253 
   260 
   254 sub identity()
   261 sub identity() {
   255 {
       
   256     my $user = `who am i`;
   262     my $user = `who am i`;
   257     chomp $user;
   263     chomp $user;
   258     $user .= " [" . ($ENV{IUS_PROFILE} || $ENV{REMOTE_USER} || "-") . "]";
   264     $user .= " [" . ($ENV{IUS_PROFILE} || $ENV{REMOTE_USER} || "-") . "]";
   259     return $user;
   265     return $user;
   260 }
   266 }
   261 
   267 
   262 sub hostname()
   268 sub hostname() {
   263 {
       
   264     my $r = `hostname -f`;
   269     my $r = `hostname -f`;
   265     chomp($r);
   270     chomp($r);
   266     return $r;
   271     return $r;
   267 }
   272 }
   268 
   273 
   269 sub mailto()
   274 sub mailto() {
   270 {
       
   271     return join(", ", @config::mailto);
   275     return join(", ", @config::mailto);
   272 }
   276 }
   273 
   277 
   274 
   278 sub check_hg_bin() {
   275 sub check_hg_bin()
       
   276 {
       
   277     if (not Logbuch::HG::hg_available()) {
   279     if (not Logbuch::HG::hg_available()) {
   278 
   280 
   279 	die <<'EOF';
   281         die <<'EOF';
   280 
   282 
   281 You requested an operation based on hg/mercurial but this tool is 
   283 You requested an operation based on hg/mercurial but this tool is 
   282 not installed!
   284 not installed!
   283 
   285 
   284 Either you could change the configuration in /etc/lobbuch/config.pm and
   286 Either you could change the configuration in /etc/lobbuch/config.pm and
   290 Exiting!
   292 Exiting!
   291 EOF
   293 EOF
   292     }
   294     }
   293 }
   295 }
   294 
   296 
   295 
       
   296 # vim:sts=4 sw=4 aw ai sm:
   297 # vim:sts=4 sw=4 aw ai sm:
   297 
   298