--- a/tele-watch.pl Thu Apr 26 11:46:36 2018 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,476 +0,0 @@
-#! /usr/bin/perl
-#
-# Script to watch directories and to perform some actions on
-# changes, highly specialized on DTELE.
-#
-# Copyright (C) 2009 2010 Heiko Schlittermann
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-#
-# Heiko Schlittermann <hs@schlittermann.de>
-# Source: (Mercurial) https://keller.schlittermann.de/hg/ius/tele-watch
-
-
-use strict;
-use warnings;
-use Pod::Usage;
-use File::Basename;
-use Getopt::Long;
-use Linux::Inotify2;
-use Unix::Syslog qw(:macros :subs);
-use Cwd qw(abs_path);
-use File::Temp qw(tempfile);
-use POSIX qw(setsid);
-use File::Find; # homepage hook
-
-my $ME = basename $0;
-my $VERSION = "0.4:b68c49bc006c+ tip
-";
-
-my $opt_block = 1;
-my $opt_daemon = 1;
-my $opt_pidfile = "/var/run/$ME.pid";
-my $opt_kill = 0;
-my $opt_version = 0;
-
-sub writef($@);
-sub updatef($@);
-sub readf($;$);
-sub notice($;@);
-sub timestamp();
-sub dir($);
-
-my %HOOK = (
- homepage => sub {
- my $dir = shift;
- my ($uid, $gid, $mode) = (stat $dir)[4, 5, 2];
- defined(my $pid = fork()) or die "Can't fork: $!\n";
- if ($pid == 0) {
- # avoid execution of END{ } blocks
- $clean_pids{$$} = 1;
- chdir $dir or die "Can't chdir to $dir: $!\n";
- for ('public') {
- mkdir $_;
- chown $uid, $gid => $_;
- chmod $mode & 07777 => $_;
- }
- system("bzr init");
- finddepth(sub {
- chown($uid, $gid, $_);
- chmod($mode & 07777, $_);
- }, ".bzr");
- }
- wait;
- },
- Angebote => sub {
- my $dir = shift;
- my ($uid, $gid, $mode) = (stat $dir)[4, 5, 2];
- defined(my $pid = fork()) or die "Can't fork: $!\n";
- if ($pid == 0) {
- chdir $dir or die "Can't chdir to $dir: $!\n";
- for ('subangebote') {
- mkdir $_ => 0770;
- $gid = getgrnam('PM');
- chown $uid, $gid => $_;
- chmod(02770, $_);
- }
- exec "true"; # avoid execution of END{ } blocks
- }
- wait;
- },
-);
-
-my %clean_pids;
-
-MAIN: {
-
- # avoid execution of END{ } blocks
- $clean_pids{$$} = 1;
-
- my @_ARGV = @ARGV;
- my %TARGET;
-
- GetOptions(
- "h|help" => sub { pod2usage(-exitval => 0, -verbose => 1) },
- "m|man" => sub { pod2usage(-exitval => 0, -verbose => 3) },
- "block!" => \$opt_block,
- "daemon!" => \$opt_daemon,
- "k|kill" => \$opt_kill,
- "v|version" => \$opt_version,
- "pidfile=s" => \$opt_pidfile,
- ) or pod2usage();
-
- if ($opt_kill) {
- die "$ME: Not killing anything, no pid file.\n" if not $opt_pidfile;
- my $pid = readf($opt_pidfile);
- die "$ME: not killing anything, no pid.\n" if not defined $pid;
- kill TERM => $pid
- or die "$ME: can't kill $pid: $!\n";
- print "$ME: sent TERM signal to $pid\n";
- exit 0;
- }
-
- if ($opt_version) {
- print "$ME: $VERSION";
- exit 0;
- }
-
- pod2usage() if not @ARGV;
- foreach (@ARGV) {
- my ($w, $t, $r) = split /:/;
- die "$ME: too many \":\" in \"$_\"\n" if defined $r;
- pod2usage() if not defined $w or not defined $t;
- $w = abs_path($w);
- $t = abs_path($t);
- $TARGET{$w} = $t;
-
- die "$ME: $w: $!\n" if not -d $w;
- die "$ME: $t: $!\n" if not -d $t;
-
- }
-
- writef($opt_pidfile, $$) if $opt_pidfile;
-
- openlog($ME, LOG_PID | LOG_PERROR, LOG_DAEMON);
- $SIG{INT} = sub { syslog(LOG_NOTICE, "got signal @_"); exit 0 };
- $SIG{TERM} = $SIG{INT};
- $SIG{__WARN__} = sub {
- warn @_ if not defined $^S;
- syslog(LOG_WARNING, "%s", "@_");
- };
- $SIG{__DIE__} = sub {
- die @_ if not defined $^S;
- syslog(LOG_ERR, "%s", "@_");
- exit $?;
- };
-
- # cleanup code
- END {
-
- return if delete $clean_pids{$$};
-
- foreach (keys %TARGET) {
- if (readf("$_/.watched") || 0 == $$) {
- unlink "$_/.watched";
- system("chattr", "+i" => "$_") if $opt_block;
- syslog(LOG_NOTICE, "cleaned $_/.watched");
- }
- }
- unlink $opt_pidfile
- if $opt_pidfile
- and defined($_ = readf($opt_pidfile))
- and $_ == $$;
- }
-
- # mark the directories as watched
- foreach (keys %TARGET) {
- my $watcher = readf("$_/.watched");
- if (defined $watcher and kill 0 => $watcher) {
- die "$_ is watched by (running) process $watcher\n";
- }
- else {
- unlink "$_/.watched";
- }
- system("chattr", "-i" => $_);
- notice("watching $_");
- writef("$_/.watched", $$);
- }
-
- $0 = "$ME @_ARGV";
- chdir("/") or die "Can't chdir to /: $!\n";
-
- if ($opt_daemon) {
- open(STDIN, "</dev/null") or die "Can't redir STDIN: $!\n";
- open(STDOUT, ">/dev/null") or die "Can't redir STDOUT: $!\n";
- defined(my $pid = fork()) or die "Can't fork: $!\n";
- if ($pid) {
- notice "child is $pid";
- # detect (u)mounts over watchpoints/targets
- exit 0;
- }
- setsid();
- open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!\n";
-
- updatef($opt_pidfile, $$) if $opt_pidfile;
- foreach (keys %TARGET) {
- updatef("$_/.watched", $$);
- }
- }
-
- # now start the real watching
- my $inotify = new Linux::Inotify2
- or die "Can't get inotify object: $!\n";
-
- foreach (keys %TARGET) {
- $inotify->watch($_, IN_CREATE | IN_MOVED_TO | IN_MOVED_FROM | IN_DELETE)
- or die "Can't create watcher for \"$_\": $!\n";
- }
-
- my %COOKIE;
- while () {
- my @events = $inotify->read;
- die "read error on notify: $!\n" if !@events;
- EVENT: foreach my $e (@events) {
- next unless $e->IN_ISDIR;
-
- my $target = $TARGET{ $e->{w}{name} };
- my $fullname = $e->fullname;
-
- if ($e->IN_CREATE) {
- notice "CREATE dir $fullname";
-
- # find the owner and permissions
- my ($uid, $gid, $mode) = (stat $fullname)[ 4, 5, 2 ];
-
- # create a link to each directory found in $target/
- foreach my $t (map { basename($_) } grep { -d } reverse(dir "$target/"))
- {
-
- my $dir = "$target/$t/$e->{name}";
-
- my $link = "$fullname/$t";
- my $hook = $HOOK{$t} if exists $HOOK{$t}
- and ref $HOOK{$t} eq "CODE";
-
- if (!-e $dir) {
- notice "mkdir $dir";
- if ($dir =~ /angebote/gi) {
- $gid = getgrnam('PM');
- mkdir $dir => 0770;
- chmod(02770, $dir);
- }
- else {
- mkdir $dir => 0755;
- chmod($mode & 07777, $dir);
- }
-
- chown($uid, $gid, $dir);
- }
-
- if ( "$link" =~ /angebote/gi )
- {
- $link = "$target/Korrespondenz/$e->{name}/Angebote";
- }
-
- notice "symlink $dir <= $link";
- unlink $link;
- symlink $dir => $link;
- $hook->($dir) if defined $hook;
-
-
- }
- chmod(0555 => $fullname);
- next EVENT;
- }
-
- if ($e->IN_MOVED_FROM) {
- notice "MOVED_FROM $fullname, set cookie";
- $COOKIE{ $e->{cookie} } = $e->{name};
- next EVENT;
- }
-
- if ($e->IN_MOVED_TO) {
- notice "MOVED_TO $fullname";
-
- if (!exists($COOKIE{ $e->{cookie} })) {
- warn "no known source for $fullname\n";
- next EVENT;
- }
-
- my $from = $COOKIE{ $e->{cookie} };
- my $from_base = basename $from;
- notice "moved here from $from";
-
- # change the link targets
-
- # find the links pointing to the $target/
- foreach my $link (grep { -l && readlink =~ /^\Q$target\E\// }
- dir "$fullname/")
- {
- my $x = readlink($link);
- my ($t) = ($x =~ /^\Q$target\E\/(.*)\/\Q$from_base\E$/);
-
- my $y = "$target/$t/$e->{name}";
-
- notice "rename $x => $y";
- rename(readlink($link), "$target/$t/$e->{name}")
- or die "Can't rename: $!\n";
-
- notice "symlink $y <= $fullname/$t";
- unlink $link;
- symlink $y => "$fullname/$t"
- or die "Can't symlink $y => $fullname/$t: $!\n";
- }
-
- delete $COOKIE{ $e->{cookie} };
- next EVENT;
- }
-
- if ($e->IN_DELETE) {
- notice "DELETE $fullname";
-
- foreach my $dir (grep { -d } dir "$target/") {
-
- -d "$dir/,old"
- or mkdir "$dir/,old" => 0755
- or die "Can't mkdir $dir/,old: $!\n";
-
- my $x = "$dir/$e->{name}";
- if (-d $x) {
- my $y = "$dir/,old/$e->{name}-" . timestamp();
- notice "move $x => $y";
- rename $x => $y or die "Can't rename $x => $y: $!\n";
- }
- }
- next EVENT;
- }
- }
- }
-}
-
-sub dir($) {
- my $base = shift;
- $base =~ s/\/*$//;
- opendir(my $dir, $base) or die "Can't open $base: $!\n";
- return map { "$base/$_" } grep !/^(?:\.\.?)/, sort readdir $dir;
-}
-
-sub timestamp() {
- my @now = localtime;
- return sprintf "%4d%02d%02d-%02d%02d%02d",
- $now[5] + 1900, $now[4] + 1, $now[3],
- @now[ 2, 1, 0 ];
-}
-
-sub notice($;@) {
- syslog(LOG_NOTICE, $_[0], @_[ 1 .. $#_ ]);
-}
-
-sub readf($;$) {
- my $fn = shift;
- my $rs = @_ ? shift : undef;
- open(my $fh, $fn) or return undef;
- return <$fh>;
-}
-
-sub writef($@) {
- my $fn = shift;
- my ($fh, $tmpfn) = tempfile(DIR => dirname($fn), UNLINK => 1)
- or die "Can't get temp file name in dir " . dirname($fn) . ": $!\n";
- print {$fh} @_;
- close $fh;
-
- # rename() should do the same job
- link($tmpfn, $fn) or do die "Can't rename $tmpfn => $fn: $!\n";
- unlink($tmpfn);
-}
-
-sub updatef($@) {
- my $fn = shift;
- open(my $fh, "+>$fn") or die "Can't open +>$fn: $!\n";
- print {$fh} @_;
-}
-
-__END__
-
-=head1 NAME
-
-tele-watch - guard the dtele directory policy
-
-=head1 SYNOPSIS
-
- tele-watch [options] "<dir:target>"...
-
-=head1 DESCRIPTION
-
-B<tele-watch> should run as a daemon.
-
-B<tele-watch> watches the list of directories I<dir>... (absolute path names)
-via "inotify" and performs some actions on:
-
-=over
-
-=item CREATION of new directory
-
-It checks F</.m/*> and assumes, that all directories there should
-reflect in the newly created directory:
-
- <NEW1>/_tmp -> /.m/_tmp/NEW1/
- <NEW1>/homepage -> /.m/homepage/NEW1/
- ...
-
-After done this it writes the name of the newly created directory into
-the file F<< <NEW1>/.name >>. The permissions of the newly created
-directories are taken from the parent (F<NEW1> in our example).
-
-=item RENAMING of a directory
-
-If the directory gets renamed, the above links needs to be updated.
-
-=item DELETION of a directory
-
-If the root directory is removed, the targets of the former links should
-be removed, we do our best, to do this. (Actually not removing the
-targets, but moving them into an F</.m/_tmp/,old> folder.)
-
-=back
-
-=head1 OPTIONS
-
-=over
-
-=item B<--[no]block>
-
-If set, on exit the watched directories are blocked by C<chattr +i>.
-(default: on)
-
-=item B<--[no]daemon>
-
-If set, the scripts daemonizes itself short after start. The pid gets
-written to the F<pidfile> (see pidfile option). (default: on)
-
-=item B<--pidfile>=I<pidfile>
-
-The name of the file holding the pid of the running process. (default:
-/var/run/tele-watch.pid)
-
-=item B<--kill>
-
-This is actually no option, it can be used to kill a running process.
-It just reads the PID from the I<pidfile> (see above) and sends a TERM
-signal. (default: off)
-
-=item B<--version>
-
-Print the version information and exit.
-
-=back
-
-=head1 COPYRIGHT
-
-GPL, see source.
-
-=head1 AUTHOR and SOURCE
-
-Heiko Schlittermann <hs@schlittermann.de>.
-The source may be found at L<https://keller.schlittermann.de/hg/ius/tele-watch>.
-
-=head1 VERSION
-
-This is b68c49bc006c+ tip
-.
-
-=cut
-
-# vim:tw=72 sts=4 ts=4 sw=4 aw ai sm: