1 #! /usr/bin/perl |
|
2 # © 2009 Schlittermann - internet & unix support |
|
3 # something about charsets |
|
4 # * We assume the LOG file is always UTF-8! |
|
5 # (I know, it's not true for historical entries, may be we can |
|
6 # build some tool to convert the file line-by-line, or at least |
|
7 # entry-by-entry -- and our database too. |
|
8 # * The mail is sent always as UTF-8! |
|
9 # * The current charset could be found using "langinfo CODESET" |
|
10 # (hopefully - needs to be tested) |
|
11 # Conclusion: |
|
12 # - On opening/reading the log file: convert from UTF-8 -> current codeset |
|
13 # - If this fails, issue a warning, use "head <something>" to show the |
|
14 # last LOG entry directly and then fire up the editor with an |
|
15 # empty file (or just added notice why we do not show the old |
|
16 # messages) |
|
17 # - After editing: convert the current messsage from the current |
|
18 # codeset to UTF-8 |
|
19 # - The same is for message on command line (but this is more easy, we |
|
20 # do not have to cope with the old message log |
|
21 |
|
22 use strict; |
|
23 use warnings; |
|
24 use File::Basename; |
|
25 use File::Temp qw(tempfile); |
|
26 use File::stat; |
|
27 use File::Copy; |
|
28 use Getopt::Long; |
|
29 use Mail::Mailer; |
|
30 use DBI; |
|
31 use MIME::QuotedPrint; |
|
32 use I18N::Langinfo qw(langinfo CODESET); |
|
33 use Text::Iconv; |
|
34 use Pod::Usage; |
|
35 use Sys::Hostname; |
|
36 |
|
37 use Logbuch::HG; |
|
38 |
|
39 use lib "/etc/logbuch"; |
|
40 use config; |
|
41 |
|
42 |
|
43 # print @config::mailto, "\n"; |
|
44 |
|
45 #+-------+---------------+------+-----+---------+----------------+ |
|
46 #| Field | Type | Null | Key | Default | Extra | |
|
47 #+-------+---------------+------+-----+---------+----------------+ |
|
48 #| id | int(11) | | MUL | NULL | auto_increment | |
|
49 #| host | varchar(255) | YES | | NULL | | |
|
50 #| date | datetime | YES | | NULL | | |
|
51 #| user | varchar(255) | YES | | NULL | | |
|
52 #| mailto| varchar(255) | YES | | NULL | | |
|
53 #| text | text | YES | MUL | NULL | | |
|
54 #| stamp | timestamp(14) | YES | | NULL | | |
|
55 #+-------+---------------+------+-----+---------+----------------+ |
|
56 |
|
57 my $ME = basename $0; |
|
58 |
|
59 my $DSN = "DBI:mysql:logbuch:pu.schlittermann.de"; |
|
60 my $USER = "logbuch"; |
|
61 my $PW = "HIDDEN"; |
|
62 |
|
63 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim"; |
|
64 my $MAGIC = "#--- all changes below are ignored ---#\n"; |
|
65 my $NODENAME = (split /\./, hostname)[0]; |
|
66 |
|
67 package config { |
|
68 # default values if not set in the config file |
|
69 our $db //= 1; |
|
70 our $logfile //= "/root/LOG.$NODENAME"; |
|
71 } |
|
72 |
|
73 my $opt_db = $config::db; |
|
74 my $opt_mail = 1; |
|
75 my $opt_message = ""; |
|
76 my $opt_apt = ""; |
|
77 my $opt_initdir = ""; |
|
78 my $opt_file = $config::logfile; |
|
79 |
|
80 my $Dbh; |
|
81 |
|
82 sub identity(); |
|
83 sub mailto(); |
|
84 sub check_hg_bin(); |
|
85 sub full_hostname(); |
|
86 sub word_encoded($); |
|
87 |
|
88 MAIN: { |
|
89 |
|
90 GetOptions( |
|
91 "db!" => \$opt_db, |
|
92 "mail!" => \$opt_mail, |
|
93 "m|message=s" => \$opt_message, |
|
94 "type=s" => \$opt_apt, |
|
95 "init-dir=s" => \$opt_initdir, |
|
96 "f|file=s" => \$opt_file, |
|
97 "help" => sub { pod2usage(-verbose => 0, -exit => 0) }, |
|
98 "man" => sub { |
|
99 pod2usage( |
|
100 -verbose => 2, |
|
101 -exit => 0, |
|
102 -noperldoc => system("perldoc -V 2>/dev/null 1>/dev/null") |
|
103 ); |
|
104 }, |
|
105 ) or pod2usage(); |
|
106 |
|
107 # override the HGUSER to the 'remote user' from our SSH connect |
|
108 $ENV{HGUSER} = env_user() // $ENV{USER} // $ENV{LOGNAME} // getpwuid($>); |
|
109 |
|
110 if ($opt_message =~ /^@(.*)/) { |
|
111 @ARGV = $1; |
|
112 $opt_message = join "", <>; |
|
113 } |
|
114 elsif ($opt_message eq "-") { |
|
115 $opt_message = join "", <STDIN>; |
|
116 } |
|
117 elsif ($opt_message =~ /^apt(?::(.*))?\@(\S+)/) { |
|
118 open(I, $2) or die "Can't open $2: $!\n"; |
|
119 $opt_message = ($1 ? "APT: $1\n" : "APT: upgrade\n") . join "", map { |
|
120 if (/^\d/) { ($_) } |
|
121 elsif (/^(?:Inst|Conf|Remv|Purg)/) { ("- $_") } |
|
122 else { () } |
|
123 } <I>; |
|
124 } |
|
125 |
|
126 if ($opt_message =~ /\n/) { |
|
127 $opt_message =~ s/\n/\n /g; |
|
128 } |
|
129 |
|
130 if (@config::notify_dirs || $opt_initdir) { |
|
131 check_hg_bin(); |
|
132 } |
|
133 |
|
134 if ($opt_initdir) { |
|
135 |
|
136 my $repo = Logbuch::HG->new(repo => $opt_initdir); |
|
137 |
|
138 $repo->is_repository() |
|
139 and die "$ME: directory already initialized, skipping\n"; |
|
140 |
|
141 # any repository is likely to contain sensitive data somewhere |
|
142 my $umask = umask 0077 |
|
143 or die "$ME: Can't set umask: $!"; |
|
144 |
|
145 $repo->init() |
|
146 or die "E: initialization failed\n"; |
|
147 |
|
148 umask $umask |
|
149 or warn "$ME: Can't restore umask: $!"; |
|
150 |
|
151 $repo->addremove(); |
|
152 $repo->commit("initial check in"); |
|
153 |
|
154 exit 0; |
|
155 } |
|
156 |
|
157 my $hg_status_text = ""; |
|
158 if (@config::notify_dirs) { |
|
159 foreach my $dir (@config::notify_dirs) { |
|
160 -d $dir or next; |
|
161 |
|
162 print "$ME: Checking $dir for modifications\n"; |
|
163 |
|
164 my $repo = Logbuch::HG->new(repo => $dir); |
|
165 $repo->is_repository() |
|
166 or die "$ME: directory $dir not initialized please call: \n", |
|
167 " # $ME --init-dir $dir \n"; |
|
168 |
|
169 $repo->addremove(); |
|
170 $hg_status_text .= $repo->status(); |
|
171 } |
|
172 } |
|
173 |
|
174 if ($opt_db) { |
|
175 END { $Dbh->disconnect() if $Dbh; } |
|
176 $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 0 }) |
|
177 or warn $DBI::errstr; |
|
178 } |
|
179 |
|
180 # Temporärfile öffnen |
|
181 my ($fh, $file) = tempfile(DIR => "/tmp", UNLINK => 1); |
|
182 |
|
183 my $auto_message = |
|
184 (not $hg_status_text) |
|
185 ? "" |
|
186 : "\n" |
|
187 . " Modified config files since last log entry listend below...\n" |
|
188 . $hg_status_text; |
|
189 |
|
190 # Kopftext eintragen |
|
191 print $fh "Date: ", scalar(localtime()), "\n", |
|
192 "User: ", identity(), "\n", |
|
193 "MailTo: ", mailto(), "\n", |
|
194 "\n", |
|
195 " * $opt_message", |
|
196 "\n", |
|
197 $auto_message, |
|
198 "\n", $MAGIC, "\n"; |
|
199 |
|
200 # LOG.<hostname> wird in Zukunft genutzt und LOG nur ein Symlink |
|
201 # dorthin |
|
202 if ($opt_file =~ /(.*)\.$NODENAME$/ and !(-e $opt_file) and (-f $1)) { |
|
203 rename($1 => $opt_file) or die "Can't rename $1 => $opt_file: !\n"; |
|
204 symlink($opt_file, $1) or die "Can't symlink $1 => $opt_file: $!\n"; |
|
205 } |
|
206 |
|
207 if (!-e $opt_file) { |
|
208 open(X, $_ = ">>$opt_file") or die "Can't open $_: $!\n"; |
|
209 close X; |
|
210 } |
|
211 |
|
212 open(IN, $_ = $opt_file) or die "Can't open $_: $!\n"; |
|
213 print $fh <IN>; |
|
214 close IN; |
|
215 |
|
216 if (!$opt_message) { |
|
217 my $stamp = stat($file)->mtime(); |
|
218 system($EDITOR, "+5", $file); |
|
219 |
|
220 if ($stamp == stat($file)->mtime()) { |
|
221 print STDERR "Nothing changed. Discarding the note.\n"; |
|
222 unlink $file; |
|
223 exit 0; |
|
224 } |
|
225 } |
|
226 |
|
227 # Jetzt wie versprochen den (eventuell geänderten Rest) aus der |
|
228 # Temp-Datei wegschneiden |
|
229 { |
|
230 my ($date, $user, $head, $text, $mailto); |
|
231 my $pos; |
|
232 |
|
233 seek $fh, 0, 0; |
|
234 for ($pos = tell $fh ; defined($_ = <$fh>) ; $pos = tell $fh) { |
|
235 |
|
236 $head .= "$_" if not $text and /^\S+:/; |
|
237 |
|
238 /^Date:\s+(.*)/ and $date = $1, next; |
|
239 /^User:\s+(.*)/ and $user = $1, next; |
|
240 /^MailTo:\s(.*)/ and $mailto = $1, next; |
|
241 last if $_ eq $MAGIC; |
|
242 |
|
243 $text .= $_ |
|
244 if /\S/ |
|
245 || $text; # somit werden die ersten Leerzeilen übersprungen |
|
246 } |
|
247 |
|
248 $text =~ s/\s*$//s; # Leerzeichen am Ende weg |
|
249 |
|
250 truncate $fh, $pos; |
|
251 seek $fh, 0, 2; |
|
252 |
|
253 if ($opt_db and $Dbh) { |
|
254 my $sth = $Dbh->prepare(" |
|
255 INSERT INTO log (host, date, user, mailto, text) |
|
256 VALUES(?, now(), ?, ?, ?)"); |
|
257 $sth->execute(full_hostname(), $user, $mailto, $text); |
|
258 print STDERR "Database entry inserted\n"; |
|
259 } |
|
260 |
|
261 if ($opt_mail and $mailto) { |
|
262 my $mailer = new Mail::Mailer "sendmail" |
|
263 or die "Can't create Mailer: $!\n"; |
|
264 |
|
265 my $subject = (split /\n/, $text)[0]; |
|
266 $subject =~ s/^\s*\S\s//; # cut the "itemizer" |
|
267 |
|
268 # and now convert to quoted printable (UTF-8) |
|
269 # =?utf-8?q?St=C3=BCmper_am_Werk=3A_Shellscripte_aus_der?= |
|
270 $subject = |
|
271 word_encoded("Service [" . full_hostname() . "]: $subject"); |
|
272 |
|
273 $mailer->open( |
|
274 { |
|
275 "Content-Type" => "text/plain; charset=utf-8", |
|
276 "Content-Transfer-Encoding" => "8bit", |
|
277 "To" => $mailto, |
|
278 "Subject" => $subject |
|
279 } |
|
280 ); |
|
281 print $mailer $head, "\n", $text; |
|
282 close $mailer; |
|
283 print STDERR "Mail sent (to $mailto).\n"; |
|
284 } |
|
285 |
|
286 if (@config::notify_dirs) { |
|
287 foreach my $dir (@config::notify_dirs) { |
|
288 -d $dir or next; |
|
289 |
|
290 my $repo = Logbuch::HG->new(repo => $dir); |
|
291 $repo->commit(); |
|
292 } |
|
293 } |
|
294 } |
|
295 |
|
296 # Und jetzt das aus der alten Datei dort anhängen |
|
297 open(IN, $_ = $opt_file) or die "Can't open $_: $!\n"; |
|
298 print $fh <IN>; |
|
299 close $fh; |
|
300 close IN; |
|
301 |
|
302 move $file, $opt_file; |
|
303 |
|
304 } |
|
305 |
|
306 sub env_user { |
|
307 foreach (qw(IUS_USER IUS_PROFILE REMOTE_USER)) { |
|
308 return $ENV{$_} if length defined $ENV{$_}; |
|
309 } |
|
310 return undef; |
|
311 } |
|
312 |
|
313 sub identity() { |
|
314 my $user = `who am i`; |
|
315 chomp $user; |
|
316 $user .= " [" . (env_user() // '-') . "]"; |
|
317 return $user; |
|
318 } |
|
319 |
|
320 sub full_hostname() { |
|
321 my $r = `hostname -f`; |
|
322 chomp($r); |
|
323 return $r; |
|
324 } |
|
325 |
|
326 sub mailto() { |
|
327 return join(", ", grep {defined} @config::mailto); |
|
328 } |
|
329 |
|
330 sub word_encoded($) { |
|
331 my $line = shift; |
|
332 |
|
333 # to get "Q" word encoding, we've to fix the result a bit |
|
334 # http://en.wikipedia.org/wiki/MIME |
|
335 # FIXME: The line may be longer than expected! |
|
336 $line = encode_qp($line); |
|
337 $line =~ s/([_?])/sprintf "=%02X", ord($1)/ige; |
|
338 $line =~ s/[ \t]/_/g; |
|
339 return join "\t", map { "=?UTF-8?Q?$_?=\n" } split /=\n/, $line; |
|
340 } |
|
341 |
|
342 sub check_hg_bin() { |
|
343 if (not Logbuch::HG::hg_available()) { |
|
344 |
|
345 die <<'EOF'; |
|
346 |
|
347 You requested an operation based on hg/mercurial but this tool is |
|
348 not installed! |
|
349 |
|
350 Either you could change the configuration in /etc/lobbuch/config.pm and |
|
351 remove lines starting with @notify_dirs, or you could simply install the |
|
352 required packages: |
|
353 |
|
354 # aptitude install mercurial rcs |
|
355 |
|
356 Exiting! |
|
357 EOF |
|
358 } |
|
359 } |
|
360 __END__ |
|
361 |
|
362 =head1 NAME |
|
363 |
|
364 log -- log utility (ius) |
|
365 |
|
366 =head1 SYNOPSIS |
|
367 |
|
368 log [--[no]db] [--[no]mail] [--init-dir <dir>] [--message <msg>] [-f|--logfile <file>] |
|
369 |
|
370 =head1 DESCRIPTION |
|
371 |
|
372 This (ius) tool prepends a custom log message to a log file (typically |
|
373 /root/LOG.<hostname>). |
|
374 |
|
375 =head1 OPTIONS |
|
376 |
|
377 B<Beware>: the defaults of some of these options may be changed through |
|
378 a configuration file. |
|
379 |
|
380 =over |
|
381 |
|
382 =item B<--[no]db> |
|
383 |
|
384 (Don't) write the log messages into the specified database (default: on) |
|
385 |
|
386 =item B<--[no]mail> |
|
387 |
|
388 (Don't) send the log message as mail. (default: on) |
|
389 |
|
390 =item B<--init-dir> I<dir> |
|
391 |
|
392 Initialize the directory I<dir> with a VCS repository. When you've done |
|
393 this, further changes to I<dir> will be logged too. |
|
394 |
|
395 =item B<--message> I<msg> |
|
396 |
|
397 The message to use. Otherwise an editor ($ENV{EDITOR}) is started. |
|
398 If the message starts with a "@", it's considered to be a file. |
|
399 |
|
400 When the messages starts as "apt[:I<text>]@I<FILE>" it starts special |
|
401 apt message processing. The default I<text> is "APT: upgrade". |
|
402 This text becomes the first line of the log message. |
|
403 |
|
404 =item B<-f>|B<--file> I<file> |
|
405 |
|
406 The logfile to use. (default: F< /root/LOG.<NODENAME>>) |
|
407 |
|
408 =back |
|
409 |
|
410 =cut |
|
411 |
|
412 # vim:sts=4 sw=4 aw ai sm: |
|