--- a/tele-watch.pl Sun Mar 01 00:03:59 2009 +0100
+++ b/tele-watch.pl Sun Mar 01 00:17:51 2009 +0100
@@ -14,8 +14,8 @@
my $ME = basename $0;
-my $opt_block = 1;
-my $opt_daemon = 1;
+my $opt_block = 1;
+my $opt_daemon = 1;
my $opt_pidfile = "/var/run/$ME.pid";
sub writef($@);
@@ -25,229 +25,237 @@
sub timestamp();
sub dir($);
-openlog($ME, LOG_PID|LOG_PERROR, LOG_DAEMON);
+openlog($ME, LOG_PID | LOG_PERROR, LOG_DAEMON);
MAIN: {
- my @_ARGV = @ARGV;
- my %TARGET;
+ my @_ARGV = @ARGV;
+ my %TARGET;
- END {
- foreach (keys %TARGET) {
- if (readf("$_/.watched") == $$) {
- unlink "$_/.watched";
- system("chattr", "+i" => "$_") if $opt_block;
- syslog(LOG_NOTICE, "cleaned $_/.watched");
- }
- }
- unlink $opt_pidfile if $opt_pidfile and readf($opt_pidfile) == $$;
- }
+ END {
+ foreach (keys %TARGET) {
+ if (readf("$_/.watched") == $$) {
+ unlink "$_/.watched";
+ system("chattr", "+i" => "$_") if $opt_block;
+ syslog(LOG_NOTICE, "cleaned $_/.watched");
+ }
+ }
+ unlink $opt_pidfile if $opt_pidfile and readf($opt_pidfile) == $$;
+ }
- $SIG{INT} = sub { syslog(LOG_NOTICE, "got signal @_"); exit 0 };
- $SIG{TERM} = $SIG{INT};
- $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", "@_");
- };
+ $SIG{INT} = sub { syslog(LOG_NOTICE, "got signal @_"); exit 0 };
+ $SIG{TERM} = $SIG{INT};
+ $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,
- "daemon!" => \$opt_daemon,
- "pidfile=s" => \$opt_pidfile,
- ) and @ARGV or pod2usage();
+ GetOptions(
+ "h|help" => sub { pod2usage(-exitval => 0, -verbose => 1) },
+ "m|man" => sub { pod2usage(-exitval => 0, -verbose => 3) },
+ "block!" => \$opt_block,
+ "daemon!" => \$opt_daemon,
+ "pidfile=s" => \$opt_pidfile,
+ )
+ and @ARGV
+ or pod2usage();
- foreach (@ARGV) {
- my ($w, $t, $r) = split /:/;
- die "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;
- }
-
- writef($opt_pidfile, $$) if $opt_pidfile;
+ foreach (@ARGV) {
+ my ($w, $t, $r) = split /:/;
+ die "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;
+ }
- # 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", $$);
- }
+ writef($opt_pidfile, $$) if $opt_pidfile;
- $0 = "$ME @_ARGV";
- chdir("/") or die "Can't chdir to /: $!\n";
+ # 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) {
- %TARGET = ();
- notice "child is $pid";
- $opt_pidfile = "";
- exit 0;
- }
- setsid();
- open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!\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) {
+ %TARGET = ();
+ notice "child is $pid";
+ $opt_pidfile = "";
+ exit 0;
+ }
+ setsid();
+ open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!\n";
- updatef($opt_pidfile, $$) if $opt_pidfile;
- foreach (keys %TARGET) {
- updatef("$_/.watched", $$);
- }
- }
+ 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";
-
+ # 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";
- }
+ 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 %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;
+ my $target = $TARGET{ $e->{w}{name} };
+ my $fullname = $e->fullname;
- if ($e->IN_CREATE) {
- notice "new dir $fullname";
+ if ($e->IN_CREATE) {
+ notice "new dir $fullname";
- # find the owner and permissions
- my ($uid, $gid, $mode) = (stat $fullname)[4,5,2];
+ # find the owner and permissions
+ my ($uid, $gid, $mode) = (stat $fullname)[ 4, 5, 2 ];
- foreach my $t (map { basename($_) } grep {-d} dir "$target/") {
- my $dir = "$target/$t/$e->{name}";
- my $link = "$fullname/$t";
+ foreach my $t (map { basename($_) } grep { -d } dir "$target/")
+ {
+ my $dir = "$target/$t/$e->{name}";
+ my $link = "$fullname/$t";
- if (!-e $dir) {
- notice "mkdir $dir";
- mkdir $dir => 0755;
- chown($uid, $gid, $dir);
- chmod($mode & 07777, $dir);
- }
+ if (!-e $dir) {
+ notice "mkdir $dir";
+ mkdir $dir => 0755;
+ chown($uid, $gid, $dir);
+ chmod($mode & 07777, $dir);
+ }
- notice "symlink $dir <= $link";
- unlink $link;
- symlink $dir => $link;
- }
- next EVENT;
- }
+ notice "symlink $dir <= $link";
+ unlink $link;
+ symlink $dir => $link;
+ }
+ next EVENT;
+ }
- if ($e->IN_MOVED_FROM) {
- notice "$fullname moves away, set cookie";
- $COOKIE{$e->{cookie}} = $e->{name};
- next EVENT;
- }
+ if ($e->IN_MOVED_FROM) {
+ notice "$fullname moves away, set cookie";
+ $COOKIE{ $e->{cookie} } = $e->{name};
+ next EVENT;
+ }
- if ($e->IN_MOVED_TO) {
+ if ($e->IN_MOVED_TO) {
+
+ if (!exists($COOKIE{ $e->{cookie} })) {
+ warn "no known source for $fullname\n";
+ next EVENT;
+ }
- 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";
+ my $from = $COOKIE{ $e->{cookie} };
+ my $from_base = basename $from;
+ notice "$fullname moved here from $from";
+
+ # change the link targets
- # change the link targets
+ # find the links pointing to the $target/
+ foreach my $link (grep { -l && readlink =~ /^$target\// }
+ dir "$fullname/")
+ {
+ my $x = readlink($link);
+ my ($t) = ($x =~ /^$target\/(.*)\/$from_base$/);
- # find the links pointing to the $target/
- foreach my $link (grep {-l && readlink =~ /^$target\// } dir "$fullname/") {
- my $x = readlink($link);
- my ($t) = ($x =~ /^$target\/(.*)\/$from_base$/);
+ my $y = "$target/$t/$e->{name}";
- my $y = "$target/$t/$e->{name}";
-
- notice "rename $x => $y";
- rename(readlink($link), "$target/$t/$e->{name}") or die "Can't rename: $!\n";
+ 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";
- }
+ 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;
- }
+ delete $COOKIE{ $e->{cookie} };
+ next EVENT;
+ }
- if ($e->IN_DELETE) {
- foreach my $dir (grep {-d} dir "$target/") {
+ if ($e->IN_DELETE) {
+ foreach my $dir (grep { -d } dir "$target/") {
- -d "$dir/,old"
- or mkdir "$dir/,old" => 0755
- or die "Can't mkdir $dir/,old: $!\n";
+ -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;
- }
- }
- }
+ 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;
+ 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];
+ 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..$#_]);
+ syslog(LOG_NOTICE, $_[0], @_[ 1 .. $#_ ]);
}
sub readf($;$) {
- my $fn = shift;
- my $rs = @_ ? shift : undef;
- open(my $fh, $fn) or return undef;
- return <$fh>;
+ 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;
- link($tmpfn, $fn) or do die "Can't rename $tmpfn => $fn: $!\n";
- unlink($tmpfn);
+ 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;
+ 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} @_;
+ my $fn = shift;
+ open(my $fh, "+>$fn") or die "Can't open +>$fn: $!\n";
+ print {$fh} @_;
}
__END__