ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Sys-FreezeThaw/FreezeThaw.pm
(Generate patch)

Comparing Sys-FreezeThaw/FreezeThaw.pm (file contents):
Revision 1.1 by root, Sat Oct 5 17:51:34 2013 UTC vs.
Revision 1.2 by root, Mon Oct 7 04:21:18 2013 UTC

… …
41package Sys::FreezeThaw; 41package Sys::FreezeThaw;
42 42
43use Carp; 43use Carp;
44 44
45$VERSION = '0.02'; 45$VERSION = '0.02';
46$PARTIAL_OK = 0;
46 47
47=item Sys::FreezeThaw::freezethaw { BLOCK } 48=item Sys::FreezeThaw::freezethaw { BLOCK }
48 49
49First tries to stop all processes. If successful, runs the given code block 50First tries to stop all processes. If successful, runs the given code block
50(or code reference), then restarts all processes again. As the system is 51(or code reference), then restarts all processes again. As the system is
… …
53 54
54Runtime errors will be caught with C<eval>. If an exception occurs it will 55Runtime errors will be caught with C<eval>. If an exception occurs it will
55be re-thrown after processes are restarted. If processes cannot be frozen 56be re-thrown after processes are restarted. If processes cannot be frozen
56or restarted, this function will throw an exception. 57or restarted, this function will throw an exception.
57 58
58Signal handlers for SIGPIPE, SIGHUP, SIGALRM, SIGUSR1 and SIGUSR2 will 59Signal handlers for SIGINT, SIGTERM, SIGPIPE, SIGHUP, SIGALRM, SIGUSR1 and
59temporarily be installed, so if you want to catch these, you have to do so 60SIGUSR2 will be installed temporarily, so if you want to catch these, you
60yourself within the executed code block. 61have to do so yourself within the executed code block.
61 62
62Try to do as few things as possible. For example, outputting text might 63Try to do as few things as possible. For example, outputting text might
63cause a deadlock, as the terminal emulator on the other side of STDOUT 64cause a deadlock, as the terminal emulator on the other side of STDOUT
64might be stopped, etc. 65might be stopped, logging to syslog might not work and so on.
65 66
66The return value of the code block is ignored right now, and the function 67The return value of the code block is ignored right now, and the function
67doesn't yet return anything sensible. 68doesn't yet return anything sensible.
68 69
69=item $token = Sys::FreezeThaw::freeze; 70=item $token = Sys::FreezeThaw::freeze
70 71
71Send SIGSTOP to all processes, and return a token that allows them to be 72Send SIGSTOP to all processes, and return a token that allows them to be
72thawed again. 73thawed again.
73 74
74If an error occurs, an exception will be thrown and all stopped processes 75If an error occurs, an exception will be thrown and all stopped processes
75will automatically be thawed. 76will automatically be thawed.
76 77
77=item Sys::FreezeThaw::thaw $token 78=item Sys::FreezeThaw::thaw $token
78 79
79Take a token returned by Sys::FreezeThaw::freeze and send all processes 80Take a token returned by Sys::FreezeThaw::freeze and send all processes
80a CONT signal, in the order required for them not to receive child STOP 81a C<CONT> signal, in the order required for them not to receive child STOP
81notifications. 82notifications.
83
84=item $Sys::FreezeThaw::PARTIAL_OK
85
86A boolean that tells C<freeze> whether it is an error if a process cannot
87be stopped. If false (the default), then C<freeze> will fail if there is
88an unstoppable process. If it is true, then C<freeze> will pretend it the
89process stopped.
82 90
83=cut 91=cut
84 92
85# this is laughably broken, but... 93# this is laughably broken, but...
86sub yield { 94sub yield {
… …
90# the maximum number of iterations per stop/cont etc. loop 98# the maximum number of iterations per stop/cont etc. loop
91# used to shield against catastrophic events (or bugs :) 99# used to shield against catastrophic events (or bugs :)
92# on current linux systems it can take an enourmous amount of 100# on current linux systems it can take an enourmous amount of
93# time for some processes to stop, but usually it only takes 101# time for some processes to stop, but usually it only takes
94# one or two iterations. 102# one or two iterations.
95sub MAX_WAIT() { 1000 } 103sub MAX_WAIT() { 10 }
96 104
97# return a list o fall pid's in the system, 105# return a list o fall pid's in the system,
98# topologically sorted parent-first 106# topologically sorted parent-first
99# skips, keys %$exclude_pid, zombies and stopped processes 107# skips, keys %$exclude_pid, zombies and stopped processes
100sub enum_pids($) { 108sub enum_pids($) {
… …
164 yield; 172 yield;
165 } 173 }
166 } 174 }
167} 175}
168 176
169sub freeze() { 177sub freeze(;$) {
170 local $@; 178 local $@;
171 179
172 my @procs; 180 my $procs;
173 181
174 eval { 182 eval {
175 for (1..MAX_WAIT) { 183 for (1..MAX_WAIT) {
176 my $passes = enum_pids { 1 => 1, $$ => 1 }; 184 my $passes = enum_pids { 1 => 1, $$ => 1 };
177 last unless @$passes; 185 last unless @$passes;
… …
187 195
188 # wait till processes are really stopped 196 # wait till processes are really stopped
189 yield; 197 yield;
190 } 198 }
191 199
192 die "unable to stop some processes: @pids" if @pids; 200 die "unable to stop some processes: @pids" if @pids && !$PARTIAL_OK;
193 } 201 }
194 } 202 }
195 }; 203 };
196 204
197 if ($@) { 205 if ($@) {
… …
207 215
208 my $token = freeze; 216 my $token = freeze;
209 217
210 eval { 218 eval {
211 local $SIG{HUP} = sub { die "ERROR: caught SIGHUP while system frozen" }; 219 local $SIG{HUP} = sub { die "ERROR: caught SIGHUP while system frozen" };
220 local $SIG{INT} = sub { die "ERROR: caught SIGINT while system frozen" };
221 local $SIG{TERM} = sub { die "ERROR: caught SIGTERM while system frozen" };
212 local $SIG{PIPE} = sub { die "ERROR: caught SIGPIPE while system frozen" }; 222 local $SIG{PIPE} = sub { die "ERROR: caught SIGPIPE while system frozen" };
213 local $SIG{ALRM} = sub { die "ERROR: caught SIGALRM while system frozen" }; 223 local $SIG{ALRM} = sub { die "ERROR: caught SIGALRM while system frozen" };
214 local $SIG{USR1} = sub { die "ERROR: caught SIGUSR1 while system frozen" }; 224 local $SIG{USR1} = sub { die "ERROR: caught SIGUSR1 while system frozen" };
215 local $SIG{USR2} = sub { die "ERROR: caught SIGUSR2 while system frozen" }; 225 local $SIG{USR2} = sub { die "ERROR: caught SIGUSR2 while system frozen" };
216 226

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines