|
1 #! /usr/bin/perl |
|
2 # (c) Heiko Schlittermann <hs@schlittermann.de> |
|
3 |
|
4 use strict; |
|
5 use warnings; |
|
6 use Pod::Usage; |
|
7 use File::Basename; |
|
8 use Getopt::Long; |
|
9 use Linux::Inotify2; |
|
10 use Unix::Syslog qw(:macros :subs); |
|
11 use Cwd qw(abs_path); |
|
12 |
|
13 my $ME = basename $0; |
|
14 |
|
15 my $opt_block; |
|
16 |
|
17 sub writef($@); |
|
18 sub readf($;$); |
|
19 sub notice($;@); |
|
20 sub timestamp(); |
|
21 |
|
22 openlog($ME, LOG_PID|LOG_PERROR, LOG_DAEMON); |
|
23 |
|
24 MAIN: { |
|
25 my %TARGET; |
|
26 my %COOKIE; |
|
27 END { |
|
28 foreach (keys %TARGET) { |
|
29 if (readf("$_/.watched") == $$) { |
|
30 unlink "$_/.watched"; |
|
31 system("chattr", "+i" => "$_") if $opt_block; |
|
32 syslog(LOG_NOTICE, "cleaned $_/.watched"); |
|
33 } |
|
34 } |
|
35 } |
|
36 |
|
37 $SIG{INT} = sub { syslog(LOG_NOTICE, "got signal @_"); exit 0 }; |
|
38 $SIG{__DIE__} = sub { die @_ if not defined $^S; |
|
39 syslog(LOG_ERR, "%s", "@_"); exit $? }; |
|
40 $SIG{__WARN__} = sub { warn @_ if not defined $^S; |
|
41 syslog(LOG_WARNING, "%s", "@_"); |
|
42 }; |
|
43 |
|
44 GetOptions( |
|
45 "h|help" => sub { pod2usage(-exitval => 0, -verbose => 1) }, |
|
46 "m|man" => sub { pod2usage(-exitval => 0, -verbose => 3) }, |
|
47 "block!" => \$opt_block, |
|
48 ) and @ARGV or pod2usage(); |
|
49 |
|
50 foreach (@ARGV) { |
|
51 my ($w, $t, $r) = split /:/; |
|
52 die "too many \":\" in \"$_\"\n" if defined $r; |
|
53 $w = abs_path($w); |
|
54 $t = abs_path($t); |
|
55 $TARGET{$w} = $t; |
|
56 } |
|
57 |
|
58 # mark the directories as watched |
|
59 foreach (keys %TARGET) { |
|
60 if (-f "$_/.watched") { |
|
61 my $pid = readf("$_/.watched"); |
|
62 if (kill 0 => $pid) { |
|
63 die "$_ is watched by (running) process $pid\n"; |
|
64 } |
|
65 } |
|
66 system("chattr", "-i" => $_); |
|
67 writef(">$_/.watched", $$); |
|
68 } |
|
69 |
|
70 # now start the real watching |
|
71 my $inotify = new Linux::Inotify2 |
|
72 or die "Can't get inotify object: $!\n"; |
|
73 |
|
74 foreach (keys %TARGET) { |
|
75 $inotify->watch($_, IN_CREATE | IN_MOVED_TO | IN_MOVED_FROM | IN_DELETE) |
|
76 or die "Can't create watcher for \"$_\": $!\n"; |
|
77 } |
|
78 |
|
79 while () { |
|
80 my @events = $inotify->read; |
|
81 die "read error on notify: $!\n" if !@events; |
|
82 EVENT: foreach my $e (@events) { |
|
83 next unless $e->IN_ISDIR; |
|
84 |
|
85 my $target = $TARGET{$e->{w}{name}}; |
|
86 my $fullname = $e->fullname; |
|
87 |
|
88 if ($e->IN_CREATE) { |
|
89 notice "new dir $fullname"; |
|
90 |
|
91 foreach my $t (map { basename($_) } grep {-d} glob "$target/*") { |
|
92 my $dir = "$target/$t/$e->{name}"; |
|
93 my $link = "$fullname/$t"; |
|
94 |
|
95 if (!-e $dir) { |
|
96 notice "mkdir $dir"; |
|
97 mkdir $dir => 0755; |
|
98 } |
|
99 |
|
100 notice "symlink $dir <= $link"; |
|
101 unlink $link; |
|
102 symlink $dir => $link; |
|
103 } |
|
104 next EVENT; |
|
105 } |
|
106 |
|
107 if ($e->IN_MOVED_FROM) { |
|
108 notice "$fullname moved from, set cookie"; |
|
109 $COOKIE{$e->{cookie}} = $e->{name}; |
|
110 next EVENT; |
|
111 } |
|
112 |
|
113 if ($e->IN_MOVED_TO) { |
|
114 |
|
115 if (!exists ($COOKIE{$e->{cookie}})) { |
|
116 warn "no known source for $fullname\n"; |
|
117 next EVENT; |
|
118 } |
|
119 |
|
120 my $from = $COOKIE{$e->{cookie}}; |
|
121 my $from_base = basename $from; |
|
122 notice "$fullname moved here from $from"; |
|
123 |
|
124 # change the link targets |
|
125 |
|
126 # find the links pointing to the $target/ |
|
127 foreach my $link (grep {-l && readlink =~ /^$target\// } glob "$fullname/*") { |
|
128 my $x = readlink($link); |
|
129 my ($t) = ($x =~ /^$target\/(.*)\/$from_base$/); |
|
130 |
|
131 my $y = "$target/$t/$e->{name}"; |
|
132 |
|
133 notice "rename $x => $y"; |
|
134 rename(readlink($link), "$target/$t/$e->{name}") or die "Can't rename: $!\n"; |
|
135 |
|
136 notice "symlink $y <= $fullname/$t"; |
|
137 unlink $link; |
|
138 symlink $y => "$fullname/$t" or die "Can't symlink $y => $fullname/$t: $!\n"; |
|
139 } |
|
140 |
|
141 delete $COOKIE{$e->{cookie}}; |
|
142 next EVENT; |
|
143 } |
|
144 |
|
145 if ($e->IN_DELETE) { |
|
146 foreach my $dir (grep {-d} glob "$target/*") { |
|
147 |
|
148 -d "$dir/,old" |
|
149 or mkdir "$dir/,old" => 0755 |
|
150 or die "Can't mkdir $dir/,old: $!\n"; |
|
151 |
|
152 my $x = "$dir/$e->{name}"; |
|
153 if (-d $x) { |
|
154 my $y = "$dir/,old/$e->{name}-" . timestamp(); |
|
155 notice "move $x => $y"; |
|
156 rename $x => $y or die "Can't rename $x => $y: $!\n"; |
|
157 } |
|
158 } |
|
159 next EVENT; |
|
160 } |
|
161 } |
|
162 } |
|
163 } |
|
164 |
|
165 sub timestamp() { |
|
166 my @now = localtime; |
|
167 return sprintf "%4d%02d%02d-%02d%02d%02d", |
|
168 $now[5]+1900, $now[4] + 1, $now[3], |
|
169 @now[2,1,0]; |
|
170 } |
|
171 |
|
172 sub notice($;@) { |
|
173 syslog(LOG_NOTICE, $_[0], @_[1..$#_]); |
|
174 } |
|
175 |
|
176 sub readf($;$) { |
|
177 my $fn = shift; |
|
178 my $rs = @_ ? shift : undef; |
|
179 open(my $fh, $fn) or die "Can't open $fn: $!\n"; |
|
180 return <$fh>; |
|
181 } |
|
182 |
|
183 sub writef($@) { |
|
184 my $fn = shift; |
|
185 open(my $fh, $fn) or die "Can't open $fn: $!\n"; |
|
186 print {$fh} @_; |
|
187 } |
|
188 |
|
189 __END__ |
|
190 |
|
191 =head1 NAME |
|
192 |
|
193 tele-watch - guard the dtele directory policy |
|
194 |
|
195 =head1 SYNOPSIS |
|
196 |
|
197 tele-watch [options] "<dir:target>"... |
|
198 |
|
199 =head1 DESCRIPTION |
|
200 |
|
201 B<tele-watch> should run as a daemon. |
|
202 |
|
203 B<tele-watch> watches the list of directories I<dir>... (absolute path names) |
|
204 via "inotify" and performs some actions on: |
|
205 |
|
206 =over |
|
207 |
|
208 =item CREATION of new directory |
|
209 |
|
210 It checks F</.m/*> and assumes, that all directories there should |
|
211 reflect in the newly created directory: |
|
212 |
|
213 <NEW1>/_tmp -> /.m/_tmp/NEW1/ |
|
214 <NEW1>/homepage -> /.m/homepage/NEW1/ |
|
215 ... |
|
216 |
|
217 After done this it writes the name of the newly created directory into |
|
218 the file F<< <NEW1>/.name >> |
|
219 |
|
220 =item RENAMING of a directory |
|
221 |
|
222 If the directory gets renamed, the above links needs to be updated. |
|
223 |
|
224 =item DELETION of a directory |
|
225 |
|
226 If the root directory is removed, the targets of the former links should |
|
227 be removed, we do our best, to do this. (Actually not removing the |
|
228 targets, but moving them into an F</.m/_tmp/,old> folder.) |
|
229 |
|
230 =back |
|
231 |
|
232 =head1 OPTIONS |
|
233 |
|
234 =over |
|
235 |
|
236 =item B<--[no]block> |
|
237 |
|
238 If set, on exit the watched directories are blocked by C<chattr +i>. |
|
239 (default: off) |
|
240 |
|
241 =back |
|
242 |
|
243 =head1 AUTHOR |
|
244 |
|
245 Heiko Schlittermann <hs@schlittermann.de> |
|
246 |
|
247 =cut |
|
248 |
|
249 # vim:tw=72 sts=4 ts=4 sw=4 aw ai sm: |