# HG changeset patch # User Heiko Schlittermann # Date 1554299246 -7200 # Node ID 3a18d3cd6ae68e89346bd7c0a4b18b688e32ed3e # Parent 86504771a1730dc731c3a78e9db29132ae55a3d1 Move to ssh://git@git.schlittermann.de/ius/logbuch.git diff -r 86504771a173 -r 3a18d3cd6ae6 Logbuch/HG.pm --- a/Logbuch/HG.pm Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,164 +0,0 @@ -# -# Simple perl interface to hg/mercurial. -# - -package Logbuch::HG; - -use warnings; -use strict; -use Carp; -use File::Which; -use Cwd qw(cwd abs_path chdir); - -use fields qw(repo); -use base qw(Class::Accessor::Fast); - -__PACKAGE__->follow_best_practice; -__PACKAGE__->mk_accessors (qw(repo)); - -# print output of external commands -# -my $external_output = 1; - -sub new { - my $class = shift; - - my $self = fields::new($class); - my $args = { @_ }; - - croak "no hg/mercurial binaries available" - if not hg_available(); - - croak "you should given an repository path" - if not defined $args->{repo}; - - $self->set_repo($args->{repo}); - - -d $self->get_repo() or croak "repository is no directory"; - - return $self; -} - -=pod - -Check if given path is a repository - -=cut - -sub is_repository($) { - my $self = shift; - - -d $self->get_repo() . "/.hg" or return 0; - - return 1; -} - - -sub init($) { - my $self = shift; - - if ($self->is_repository()) { - carp "you are trying to initilize an already initilized repository, skipping"; - return 1; - } - - return _run($self->get_repo(), "hg init"); -} - -=pod - -Check if hg binaries are available. -Static methode. - -=cut - -sub hg_available() -{ - (not defined which('hg')) and return 0; - return 1; -} - -=pod - -Update working copy of repository. Adds all new files, automatically -removes no more existing files from repository. - -=cut -sub addremove($) -{ - my $self = shift; - - return _run( $self->get_repo(), "hg addremove" ); -} - -=pod - -Commit working copy to repository. - -=cut -sub commit($;$) { - my $self = shift; - my $message = shift || "auto commit message"; - - return _run( $self->get_repo(), "hg commit -m \"$message\""); -} - - -=pod - -Print status text of repository. - -NOTE: path names will be expanted to absoulte paths!!! - -=cut - -sub status($) { - my $self = shift; - - my @result = _run( $self->get_repo(), "hg status"); - - my $path = $self->get_repo() . "/"; - $result[1] =~ s/^([^\s]+)(\s+)(.*)$/${1}${2}${path}${3}/mg; - - return "$result[1]\n" if $result[1]; -} - - -=pod - -Run shell command in modified environment: - - * cwd is changed to $self->repo - * STDOUT and STDERR are caputred - * return exit code - -=cut - -sub _run($$) { - my $to_dir = shift; - my $cmd = shift; - my $cwd = cwd(); - - chdir($to_dir) or croak "cannot change to repository: $!"; - - # redirect stderr to stdout - $cmd .= " 2>&1"; - - my $output = `$cmd`; - chomp $output; - - chdir($cwd) or croak "cannot chdir back from repository: $!"; - - my $ret = ($? >> 8); - - if (wantarray) { - return ($ret, $output); - } - - print "D: $output\n" if ("$output" and $external_output); - return ($ret > 0) ? 0 : 1; -} - -1; - -# vim: sw=4 sts=4 aw diff -r 86504771a173 -r 3a18d3cd6ae6 Makefile --- a/Makefile Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -prefix = /usr/local -sbindir = $(prefix)/sbin -sysconfdir = /etc/logbuch - -bin_SCRIPTS = log - -.PHONY: all check install clean - - -all: check $(bin_SCRIPTS) log.8 - -install: all - install -d -m 0755 $(DESTDIR)/$(sysconfdir) - tools/chkconfig $(DESTDIR)/$(sysconfigdir)/config.pm \ - && install -m 644 config.pm $(DESTDIR)/$(sysconfdir)/config.pm - tools/signconfig $(DESTDIR)/$(sysconfdir)/config.pm - install -d -m 0755 $(DESTDIR)/$(sbindir) - install -m 0755 $(bin_SCRIPTS) $(DESTDIR)/$(sbindir)/ - - install -d -m 0755 $(DESTDIR)/usr/share/perl5/Logbuch - install -m 0644 Logbuch/HG.pm $(DESTDIR)/usr/share/perl5/Logbuch/ - -clean: - -rm -f $(bin_SCRIPTS) - -check: - @-rm -f .e - @cat modules | while read REPLY; do \ - perl -M$$REPLY -e '' && continue; \ - echo "MISSING perl library: \"$$REPLY\""; \ - touch .e; \ - done - @rm .e 2>/dev/null && false || true - -log.8: - pod2man --section 8 log.pl > $@ - -%: %.pl - perl -c $< - cp -f $< $@ - chmod -w+x $@ diff -r 86504771a173 -r 3a18d3cd6ae6 README --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README Wed Apr 03 15:47:26 2019 +0200 @@ -0,0 +1,1 @@ +See git ssh://git@git.schlittermann.de/ius/logbuch.git diff -r 86504771a173 -r 3a18d3cd6ae6 config.pm --- a/config.pm Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -package config; - -use Sys::Hostname; -my $NODENAME = (split /\./, hostname)[0]; - -@mailto = "root"; -$logfile = "/root/LOG.$NODENAME"; - -# @notify_dirs = qw(/etc); - -$db = 1; - -1; diff -r 86504771a173 -r 3a18d3cd6ae6 debian/changelog --- a/debian/changelog Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,365 +0,0 @@ -logbuch (0.49+nmu1) stable oldstable; urgency=medium - - * Non-maintainer upload. - * +missing dep - - -- Matthias Förste Thu, 27 Apr 2017 16:53:26 +0200 - -logbuch (0.48) stable oldstable; urgency=medium - - * change release - - -- Heiko Schlittermann (HS12-RIPE) Wed, 12 Aug 2015 19:08:44 +0200 - -logbuch (0.47) wheezy; urgency=medium - - * Remove debug-die: - - -- Heiko Schlittermann (HS12-RIPE) Wed, 12 Aug 2015 18:06:50 +0200 - -logbuch (0.46) wheezy; urgency=medium - - * Fix idendity line: - - -- Heiko Schlittermann (HS12-RIPE) Wed, 12 Aug 2015 18:05:32 +0200 - -logbuch (0.45) wheezy; urgency=medium - - * Set the HGUSER environment, use IUS_USER, IUS_PROFILE, REMOTE_USER: - - -- Heiko Schlittermann (HS12-RIPE) Wed, 12 Aug 2015 18:01:52 +0200 - -logbuch (0.44+nmu3) wheezy; urgency=low - - * Non-maintainer upload. - * don't ignore custom logfile location - - -- Matthias Förste Tue, 13 Jan 2015 09:29:13 +0100 - -logbuch (0.44+nmu2) wheezy; urgency=low - - * Non-maintainer upload. - * re-enabled newer package block syntax (for perls in debian wheezy and - newer) - - -- Matthias Förste Tue, 06 Jan 2015 11:22:40 +0100 - -logbuch (0.44+nmu1) squeeze; urgency=low - - * Non-maintainer upload. - * fix package block syntax for older perls - - -- Matthias Förste Tue, 06 Jan 2015 11:04:51 +0100 - -logbuch (0.44) stable oldstable; urgency=medium - - * [merged] from older revision: - - -- Heiko Schlittermann (HS12-RIPE) Mon, 05 Jan 2015 11:32:50 +0100 - -logbuch (0.43) stable oldstable; urgency=medium - - * fixed the source maintainer - - -- Heiko Schlittermann (HS12-RIPE) Mon, 05 Jan 2015 11:23:19 +0100 - -logbuch (0.42) stable oldstable; urgency=medium - - * quieten the perl compiler: - - -- Heiko Schlittermann (HS12-RIPE) Mon, 05 Jan 2015 10:55:59 +0100 - -logbuch (0.40) stable old-stable; urgency=low - - * Non-maintainer upload. - * added ignores: - * untracked autogenerated example files: - * hgignored autogenerated example files: - * repositories für others/world unzugänglich initialisieren: - * fehlerbehandlung: - * removed debian package example files: - * removed noise: - * fixed lintian warning: dh_installmanpages-is-obsolete: - * [changelog]: - * fixed lintian warning: ancient-standards-version: - * fixed lintian warning: helper-templates-in-copyright: - * [changelog]: - * fixed defined (@array): Neue Perlversionen mögen das nicht mehr. - * added $db option to config: - * added $db to config.pm as $db = 1: - - -- Heiko Schlittermann (HS12-RIPE) Sat, 03 Jan 2015 22:46:40 +0100 - -logbuch (0.39) stable; urgency=low - - * grep {defined} … and not grep defined => … - - -- Heiko Schlittermann Tue, 28 Aug 2012 09:21:00 +0200 - -logbuch (0.38) stable; urgency=low - - * fixed empty mailto again - - -- Heiko Schlittermann Tue, 28 Aug 2012 09:17:40 +0200 - -logbuch (0.37) stable; urgency=low - - * [merged] - * fixed empty mailto and qw() as parens - - -- Heiko Schlittermann Tue, 28 Aug 2012 09:11:47 +0200 - -logbuch (0.36+nmu1) stable; urgency=low - - [ Matthias Förste ] - * Non-maintainer upload. - * split status texts with newline when using multiple repos - * added build dep: libclass-accessor-perl - - [ Heiko Schlittermann ] - * updates between revision 0.34 and 0.36 - * split status texts with newline when using multiple repos - * untracked debian/dirs because its handled by dh_make, no?; ignored - debian/source/format because it is handled by dh_make, no?; added - libclass-accessor-perl to build deps because the syntax check in the - implicit rule for the perl script requires it; bumped revision - number; - - -- Heiko Schlittermann Tue, 28 Aug 2012 09:11:47 +0200 - -logbuch (0.36) stable; urgency=low - - * removed empty usr/bin - * extended the description - - -- Heiko Schlittermann Wed, 21 Sep 2011 07:40:07 +0200 - -logbuch (0.35) stable; urgency=low - - * mailto sollte keine Domain enthalten - sonst kann der lokale root-Alias nicht greifen. Selbst bei - @localhost ist es auf einigen Systemen problematisch. - - -- Heiko Schlittermann Wed, 21 Sep 2011 07:33:48 +0200 - -logbuch (0.34) stable; urgency=low - - * fixed lintian bugs - * added manpage - * moved to /usr/sbin - - -- Heiko Schlittermann Fri, 16 Sep 2011 12:31:26 +0200 - -logbuch (0.33) stable; urgency=low - - * moved to new dh_make - - -- Heiko Schlittermann Thu, 15 Sep 2011 09:27:02 +0200 - -logbuch (0.32) stable; urgency=low - - * removed recommends: perl-doc - - -- Heiko Schlittermann Thu, 15 Sep 2011 09:11:17 +0200 - -logbuch (0.31) stable; urgency=low - - * fixed connection setup - - -- Heiko Schlittermann Wed, 09 Sep 2009 16:33:09 +0200 - -logbuch (0.30) stable; urgency=low - - * added correct handling of non ascii subject lines - * use LOG. instead of LOG (and add a suitable symlink to - ease the transition - - -- Heiko Schlittermann Tue, 08 Sep 2009 23:19:25 +0200 - -logbuch (0.29) stable; urgency=low - - * new upstream - * corrected the depends in control file - - -- Christian Arnold Thu, 26 Mar 2009 09:16:40 +0100 - -logbuch (0.28-1) stable; urgency=low - - * new upstream - * add mail header Content-Type and Content-Transfer-Encoding - - -- Christian Arnold Tue, 24 Mar 2009 10:49:48 +0100 - -logbuch (0.27-1) stable; urgency=low - - * new upstream - * use File::Copy::move instead of rename to support move between - filesystems - - -- Marcus Obst Wed, 11 Feb 2009 12:05:40 +0100 - -logbuch (0.26-1) stable; urgency=low - - * new upstream - - -- Marcus Obst Mon, 09 Feb 2009 13:43:40 +0100 - -logbuch (0.25-3) stable; urgency=low - - * commented out @notify_dirs - - -- Marcus Obst Wed, 04 Feb 2009 09:04:22 +0100 - -logbuch (0.25-2) stable; urgency=low - - * fix dependcies - - -- Marcus Obst Wed, 04 Feb 2009 08:35:28 +0100 - -logbuch (0.25-1) stable; urgency=low - - * fix dependcies - - -- Marcus Obst Tue, 03 Feb 2009 11:49:53 +0100 - -logbuch (0.25) stable; urgency=low - - * new upstream - file modification detection - - -- Marcus Obst Tue, 03 Feb 2009 11:49:53 +0100 - -logbuch (0.24) stable; urgency=low - - * new upstream - long subject lines - - -- Heiko Schlittermann Fri, 22 Aug 2008 00:27:10 +0200 - -logbuch (0.23-1) stable; urgency=low - - * new upstream - * IUS_PROFILE environment (fallback: REMOTE_USER) - - -- Heiko Schlittermann Wed, 16 Jan 2008 15:35:01 +0100 - -logbuch (0.21-1) stable; urgency=low - - * new upstream (format) - - -- Heiko Schlittermann Tue, 01 Aug 2006 10:36:13 +0200 - -logbuch (0.20-1) stable; urgency=low - - * new upstream (typo) - - -- Heiko Schlittermann Tue, 01 Aug 2006 09:36:13 +0200 - -logbuch (0.18-1) stable; urgency=low - - * new upstream (options changed for apt) - - -- Heiko Schlittermann Tue, 01 Aug 2006 09:36:13 +0200 - -logbuch (0.17-2) stable; urgency=low - - * nochmal - - -- Heiko Schlittermann Tue, 01 Aug 2006 09:36:13 +0200 - -logbuch (0.17-1) stable; urgency=low - - * --help geht jetzt besser - - -- Heiko Schlittermann Tue, 01 Aug 2006 09:36:13 +0200 - -logbuch (0.16-1) stable; urgency=low - - * new upstream for stable - - -- Heiko Schlittermann Tue, 01 Aug 2006 09:36:13 +0200 - -logbuch (0.15-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Wed, 01 Jun 2005 16:50:31 +0200 - -logbuch (0.14-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Wed, 01 Jun 2005 16:50:31 +0200 - -logbuch (0.13-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Wed, 01 Jun 2005 16:50:31 +0200 - -logbuch (0.12-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Wed, 14 Jan 2004 10:08:15 +0100 - -logbuch (0.10-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Wed, 16 Apr 2003 09:32:10 +0200 -logbuch (0.9-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 15:43:11 +0200 - -logbuch (0.8-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 12:41:27 +0200 -logbuch (0.7-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 12:41:27 +0200 - -logbuch (0.6-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 12:40:27 +0200 - -logbuch (0.5-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 09:49:27 +0200 - -logbuch (0.4-2) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Tue, 8 Apr 2003 00:31:27 +0200 - -logbuch (0.3-2) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Fri, 4 Apr 2003 17:58:52 +0200 -logbuch (0.2-2) unstable; urgency=low - - * depends on dbi, dbd - - -- Heiko Schlittermann Fri, 4 Apr 2003 17:26:53 +0200 - -logbuch (0.2-1) unstable; urgency=low - - * new upstream - - -- Heiko Schlittermann Fri, 4 Apr 2003 11:39:43 +0200 -logbuch (0.1-1) unstable; urgency=low - - * Initial Release. - - -- Heiko Schlittermann Fri, 4 Apr 2003 10:03:49 +0200 - diff -r 86504771a173 -r 3a18d3cd6ae6 debian/compat --- a/debian/compat Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -7 diff -r 86504771a173 -r 3a18d3cd6ae6 debian/control --- a/debian/control Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -Source: logbuch -Section: utils -Priority: optional -Maintainer: Heiko Schlittermann (HS12-RIPE) -Build-Depends: debhelper (>= 7.0.50), libmailtools-perl, libdbi-perl, libdbd-mysql-perl, libfile-which-perl, libclass-accessor-perl -Standards-Version: 3.9.6 -Homepage: http://schlittermann.de/ - -Package: logbuch -Architecture: all -Suggests: mercurial, perl-doc -Recommends: vim -Depends: ${misc:Depends}, ${perl:Depends}, libdbi-perl, libdbd-mysql-perl, libmailtools-perl, - libfile-which-perl, libclass-accessor-perl, libtext-iconv-perl -Description: server maintenance log"buch" - A simple script for tracking server changes in a logfile. - It supports in having a "machine change log", entries have - to be entered manually, but it also installs some scripts - to automatically log package installations/deinstallations. diff -r 86504771a173 -r 3a18d3cd6ae6 debian/copyright --- a/debian/copyright Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -It was downloaded from https://ssl.schlittermann.de/hg/logbuch -Upstream Author: Heiko Schlittermann (HS12-RIPE) -Copyright: (C) 2011-205 Heiko Schlittermann -License: GNU Public License v3 or newer. - -Upstream Author: Heiko Schlittermann diff -r 86504771a173 -r 3a18d3cd6ae6 debian/dirs diff -r 86504771a173 -r 3a18d3cd6ae6 debian/docs diff -r 86504771a173 -r 3a18d3cd6ae6 debian/logbuch.links --- a/debian/logbuch.links Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2 +0,0 @@ -/usr/sbin/log /usr/sbin/logbuch -/usr/share/man/man8/log.8.gz /usr/share/man/man8/logbuch.8.gz diff -r 86504771a173 -r 3a18d3cd6ae6 debian/logbuch.manpages --- a/debian/logbuch.manpages Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -log.8 diff -r 86504771a173 -r 3a18d3cd6ae6 debian/manpages --- a/debian/manpages Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -log.8 diff -r 86504771a173 -r 3a18d3cd6ae6 debian/preinst --- a/debian/preinst Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -#! /bin/sh -# preinst script for logbuch -# -# see: dh_installdeb(1) - -set -e - -case "$1" in - install|upgrade) - if [ -n "$2" ] && \ - dpkg --compare-versions "$2" le "0.39" && \ - [ -f /etc/logbuch/config.pm ]; then - dirs=$(perl -e 'use lib "/etc/logbuch"; use config; print join " ", @config::notify_dirs'); - if [ -n "$dirs" ]; then - for d in "$dirs"; do - if [ -d $d/.hg ]; then - chmod -R go= $d/.hg - else - echo "Warning: '$d/.hg' is not a directory" >&2 - fi - done - fi - fi - ;; - - abort-upgrade) - ;; - - *) - echo "preinst called with unknown argument \`$1'" >&2 - exit 1 - ;; -esac - -#DEBHELPER# - -exit 0 - - diff -r 86504771a173 -r 3a18d3cd6ae6 debian/rules --- a/debian/rules Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -#!/usr/bin/make -f -# Sample debian/rules that uses debhelper. -# GNU copyright 1997 to 1999 by Joey Hess. - -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 -export PERL5LIB= - -%: - dh $@ - -override_dh_auto_build: - $(MAKE) prefix=/usr - -override_dh_auto_install: - $(MAKE) prefix=/usr DESTDIR=debian/logbuch install diff -r 86504771a173 -r 3a18d3cd6ae6 debian/source/format --- a/debian/source/format Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -3.0 (native) diff -r 86504771a173 -r 3a18d3cd6ae6 debian/source/options --- a/debian/source/options Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -tar-ignore -tar-ignore *.ex -tar-ignore *.EX 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: diff -r 86504771a173 -r 3a18d3cd6ae6 modules --- a/modules Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -DBI -File::Basename -File::Copy -File::stat -File::Temp -File::Which -Getopt::Long -I18N::Langinfo -Mail::Mailer -MIME::QuotedPrint -Text::Iconv -Pod::Usage diff -r 86504771a173 -r 3a18d3cd6ae6 tools/chkconfig --- a/tools/chkconfig Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -#! /usr/bin/perl -use strict; -use warnings; -use File::Temp; - -my $pattern = "# sha1:"; - -die "need exactly one filename" if not @ARGV == 1; - -if ($0 =~ /chk/) { - local $" = ""; - exit 0 if not -e $ARGV[0]; - my @file = <>; - - my $expected = ""; - $expected = pop @file if $file[-1] =~ /^$pattern/; - - my $tmp = new File::Temp; - open(SHA1, "|sha1sum >" . $tmp->filename); - print SHA1 @file; - close(SHA1); - seek($tmp, 0, 0); - - my $current = $pattern . <$tmp>; - - exit 0 if $current eq $expected; - exit 1; -} - -if ($0 =~ /sig/) { - local $" = ""; - open(FILE, "+<$ARGV[0]") or die "Can't open $ARGV[0]: $!\n"; - my @file = ; - pop @file if $file[-1] =~ /^$pattern/; - seek(FILE, 0, 0); - print FILE @file, $pattern; - truncate(FILE, tell FILE); - close FILE; - open(SHA1, "|sha1sum >>$ARGV[0]"); - print SHA1 @file; - close(SHA1); -} diff -r 86504771a173 -r 3a18d3cd6ae6 tools/signconfig --- a/tools/signconfig Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -chkconfig \ No newline at end of file