--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tele-watch.pl Sat Feb 28 22:04:02 2009 +0100
@@ -0,0 +1,249 @@
+#! /usr/bin/perl
+# (c) Heiko Schlittermann <hs@schlittermann.de>
+
+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);
+
+my $ME = basename $0;
+
+my $opt_block;
+
+sub writef($@);
+sub readf($;$);
+sub notice($;@);
+sub timestamp();
+
+openlog($ME, LOG_PID|LOG_PERROR, LOG_DAEMON);
+
+MAIN: {
+ my %TARGET;
+ my %COOKIE;
+ END {
+ foreach (keys %TARGET) {
+ if (readf("$_/.watched") == $$) {
+ unlink "$_/.watched";
+ system("chattr", "+i" => "$_") if $opt_block;
+ syslog(LOG_NOTICE, "cleaned $_/.watched");
+ }
+ }
+ }
+
+ $SIG{INT} = sub { syslog(LOG_NOTICE, "got signal @_"); exit 0 };
+ $SIG{__DIE__} = sub { die @_ if not defined $^S;
+ syslog(LOG_ERR, "%s", "@_"); exit $? };
+ $SIG{__WARN__} = sub { warn @_ if not defined $^S;
+ syslog(LOG_WARNING, "%s", "@_");
+ };
+
+ GetOptions(
+ "h|help" => sub { pod2usage(-exitval => 0, -verbose => 1) },
+ "m|man" => sub { pod2usage(-exitval => 0, -verbose => 3) },
+ "block!" => \$opt_block,
+ ) and @ARGV or pod2usage();
+
+ foreach (@ARGV) {
+ my ($w, $t, $r) = split /:/;
+ die "too many \":\" in \"$_\"\n" if defined $r;
+ $w = abs_path($w);
+ $t = abs_path($t);
+ $TARGET{$w} = $t;
+ }
+
+ # mark the directories as watched
+ foreach (keys %TARGET) {
+ if (-f "$_/.watched") {
+ my $pid = readf("$_/.watched");
+ if (kill 0 => $pid) {
+ die "$_ is watched by (running) process $pid\n";
+ }
+ }
+ system("chattr", "-i" => $_);
+ writef(">$_/.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";
+ }
+
+ 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 "new dir $fullname";
+
+ foreach my $t (map { basename($_) } grep {-d} glob "$target/*") {
+ my $dir = "$target/$t/$e->{name}";
+ my $link = "$fullname/$t";
+
+ if (!-e $dir) {
+ notice "mkdir $dir";
+ mkdir $dir => 0755;
+ }
+
+ notice "symlink $dir <= $link";
+ unlink $link;
+ symlink $dir => $link;
+ }
+ next EVENT;
+ }
+
+ if ($e->IN_MOVED_FROM) {
+ notice "$fullname moved from, set cookie";
+ $COOKIE{$e->{cookie}} = $e->{name};
+ next EVENT;
+ }
+
+ if ($e->IN_MOVED_TO) {
+
+ 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 "$fullname moved here from $from";
+
+ # change the link targets
+
+ # find the links pointing to the $target/
+ foreach my $link (grep {-l && readlink =~ /^$target\// } glob "$fullname/*") {
+ my $x = readlink($link);
+ my ($t) = ($x =~ /^$target\/(.*)\/$from_base$/);
+
+ 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) {
+ foreach my $dir (grep {-d} glob "$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 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 die "Can't open $fn: $!\n";
+ return <$fh>;
+}
+
+sub writef($@) {
+ 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 >>
+
+=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: off)
+
+=back
+
+=head1 AUTHOR
+
+Heiko Schlittermann <hs@schlittermann.de>
+
+=cut
+
+# vim:tw=72 sts=4 ts=4 sw=4 aw ai sm: