1package Commands::Guarded;
2
3use 5.006;
4use strict;
5use warnings;
6use Carp;
7use IO::File;
8
9require Exporter;
10
11our @ISA = qw(Exporter);
12
13our %EXPORT_TAGS = (
14		    utils => [ qw(
15				  fgrep
16				  readf
17				  appendf
18				  writef
19				 ) ],
20		    step => [qw(
21				step
22				ensure
23				using
24				sanity
25				rollback
26			       )],
27		    other => [qw(
28				 verbose
29				 clear_rollbacks
30				)]
31		   );
32
33$EXPORT_TAGS{default} = $EXPORT_TAGS{step};
34
35foreach (keys %EXPORT_TAGS) {
36   push @{$EXPORT_TAGS{'all'}}, @{$EXPORT_TAGS{$_}}
37}
38
39our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} });
40
41our @EXPORT = ( @{ $EXPORT_TAGS{'default'}} );
42
43our $VERSION = '1.01';
44
45# A constructor that's exported (horrors!) -- everything starts here
46
47sub step ( $@ ) {
48   my $step = __PACKAGE__->new(@_);
49   unless (defined wantarray) {
50      $step->do();
51      return;
52   }
53   return $step;
54}
55
56# Define blocks
57
58my @defined_blocks = qw(
59			ensure
60			using
61			sanity
62			rollback
63		       );
64
65# Create an exportable subroutine called BLOCK_block for each name above
66# that blesses the block passed as the appropriate class.  Autocreate
67# the class and make it a subclass of Commands::Guarded::Block.
68
69foreach my $block (@defined_blocks) {
70   my $block_block = "$block" . "_block";
71   my $class = "Commands::Guarded::Block::$block_block";
72   no strict 'refs';
73   @{"${class}::ISA"} = qw(Commands::Guarded::Block);
74   # install the exportable sub
75   *$block = sub ( &;@ ) {
76      my ($block, @rest) = @_;
77      $block = bless $block, $class;
78      return ($block, @rest);
79   };
80   # install the accessor method
81   *$block_block = sub { $_[0]->{$block_block} };
82}
83
84# The only method for this class, so we just install it here rather than creating
85# a separate package file
86
87sub Commands::Guarded::Block::add {
88   # Add block to enclosing step
89   my $self = shift;
90   my ($type) = (ref($self) =~ /.*::(.*)/);
91   my $step = shift;
92   $step->{$type} = $self;
93}
94
95# Verbosity on (or off); defaults to env variable or 0
96my $verbose = exists $ENV{GUARDED_VERBOSE} ? $ENV{GUARDED_VERBOSE} : 0;
97sub verbose (;$) {
98   if (@_) {
99      $verbose = shift;
100   }
101   $verbose;
102}
103
104sub new {
105   my $class = shift;
106   $class = ref($class) || $class;
107   my ($name, @blocks) = @_;
108   my $self = bless {
109		     name => $name,
110		    }, $class;
111   foreach my $block (@blocks) {
112      $block->add($self);
113   }
114   if (not exists $self->{using_block}) {
115       $self->{using_block} = sub { 1 };
116   }
117   croak "Missing 'ensure' block for step"
118       unless exists $self->{ensure_block};
119   return $self;
120}
121
122sub _diag ( @ ) {
123   print STDERR @_ if verbose;
124}
125
126# Rollback handlers
127
128our @rollbacks;
129
130sub _register_rollback {
131   my $self = shift;
132   if (defined $self->rollback_block) {
133      push @rollbacks, [$self->rollback_block => \@_];
134   }
135}
136
137sub clear_rollbacks {
138   @rollbacks = ();
139}
140
141sub _do_rollbacks () {
142   while (@rollbacks) {
143      my $rollback = pop @rollbacks;
144      my $sub = $rollback->[0];
145      my @args = @{$rollback->[1]};
146      $sub->(@args);
147   }
148}
149
150sub _fail ( @ ) {
151   _do_rollbacks;
152   croak @_;
153}
154
155
156# The only accessor not dynamically created
157
158sub name {
159   my $self = shift;
160   my $name = $self->{name};
161   if (@_) {
162      $name .= "(@_)";
163   }
164   $name;
165}
166
167sub _check_sanity {
168   my $self = shift;
169   if (defined $self->sanity_block) {
170      $self->sanity_block->(@_)
171	or _fail "Sanity check for " . $self->name(@_) . " failed";
172   }
173}
174
175sub _do_pre_using {
176   my $self = shift;
177   $self->_check_sanity(@_);
178   $self->_register_rollback(@_);
179   return $self->ensure_block->(@_);
180}
181
182sub do {
183   my $self = shift;
184   unless ($self->_do_pre_using(@_)) {
185      _diag "Doing step " . $self->name(@_) . "\n";
186      my @returns;
187      # Preserve calling context in case we're being used for return value
188      # (But why would anyone want to do that?)
189      if (wantarray) {
190	 @returns = $self->using_block->(@_);
191      } elsif (defined wantarray) {
192	 $returns[0] = $self->using_block->(@_);
193      } else {
194	 $self->using_block->(@_);
195      }
196      $self->_check_sanity(@_);
197      if ($self->ensure_block->(@_)) {
198	 _diag "Step " . $self->name(@_) . " succeeded\n";
199	 return @returns;
200      }
201      _fail "Step " . $self->name(@_) . " failed";
202   }
203   _diag "Skipping step " . $self->name . "\n";
204   return;
205}
206
207sub do_foreach {
208   my $self = shift;
209   my @usings;
210   foreach my $arg (@_) {
211      unless ($self->_do_pre_using($arg)) {
212	 push @usings, $arg;
213      } else {
214	 _diag "Skipping step " . $self->name($arg) . "\n";
215      }
216   }
217   foreach my $arg (@usings) {
218      _diag "Doing step " . $self->name($arg) . "\n";
219      $self->using_block->($arg);
220      $self->_check_sanity($arg);
221      if ($self->ensure_block->($arg)) {
222	 _diag "Step " . $self->name($arg) . " succeeded\n";
223      } else {
224	 _fail "Step " . $self->name . " failed";
225      }
226   }
227   return;
228}
229
230# Useful utilities
231
232sub readf ( $ ) {
233   my $fh = new IO::File $_[0]
234     or die "Can't open $_[0] for reading: $!\n";
235   $fh;
236}
237
238sub writef ( $ ) {
239   my $fh = new IO::File ">$_[0]"
240     or die "Can't open $_[0] for writing: $!\n";
241   $fh;
242}
243
244sub appendf ( $ ) {
245   my $fh = new IO::File ">>$_[0]"
246     or die "Can't open $_[0] for appending: $!\n";
247   $fh;
248}
249
250sub fgrep ( $$ ) {
251   my ($re, $fh) = @_;
252   unless (ref $fh) {
253      $fh = readf $fh;
254   }
255   while (<$fh>) {
256      return 1 if /$re/;
257   }
258   return 0;
259}
260
2611;
262__END__
263=head1 NAME
264
265Commands::Guarded - Better scripts through guarded commands
266
267=head1 SYNOPSIS
268
269  use Commands::Guarded;
270
271  my $var = 0;
272
273  step something =>
274    ensure { $var == 1 }
275    using { $var = 1 }
276    ;  # $var is now 1
277
278  step nothing =>
279    ensure { $var == 1 }
280    using { $var = 2 } # bug!
281    ;  # $var is still 1 (good thing too)
282
283  my $brokeUnless5 =
284    step brokenUnless5 =>
285    ensure { $var == 5 }
286    using { $var = shift }
287    ; # nothing happens yet
288
289  print "var: $var\n"; # prints 1
290
291  $brokeUnless5->do(5);
292
293  print "now var: $var\n"; # prints 5
294
295  step fail =>
296    ensure { $var == 3 }
297    using { $var = 2 }
298    ; # Exception thrown here
299
300=head1 DESCRIPTION
301
302This module implements a deterministic, rectifying variant on
303Dijkstra's guarded commands.  Each named step is passed two blocks: an
304C<ensure> block that defines a test for a necessary and sufficient
305condition of the step, and a C<using> block that will cause that
306condition to obtain.  (If the C<using> block is ommitted, the step
307acts as a simple assertion.)
308
309If C<step> is called in void context (i.e., is not assigned to
310anything or used as a value), the step is run immediately, as in this
311pseudocode:
312
313  unless (ENSURE) {
314    USING;
315    die unless ENSURE;
316  }
317
318If C<step> is called in scalar or array context, execution is deferred
319and instead a Commands::Guarded object is returned, which can be
320executed as above using the C<do> method.  If C<do> is given
321arguments, they will be passed to the C<ensure> block and (if
322necessary) the C<using> block.
323
324The interface to Commands::Guarded is thus a hybrid of exported
325subroutines (see B<SUBROUTINES> below) and non-exported methods (see
326B<METHODS>).
327
328For a detailed discussion of the reason for this module's existence,
329see B<RATIONALE> below.
330
331=head1 SUBROUTINES
332
333=over
334
335=item step NAME => EXPR...
336
337Defines a new guarded command step.  If called in void context, the step
338is executed immediately.  If called in scalar or array context (i.e.,
339in an expression or assignment), a Commands::Guarded object is
340returned (see B<METHODS> below).
341
342NAME is a string that will be printed on failure (also see C<verbose>
343below).
344
345EXPR is one or more Commands::Guarded blocks (see B<BLOCKS> below).
346Typically at least a C<ensure> and C<using> block will be included.
347
348Note that because C<step> is a subroutine and not a control structure
349(though it acts like one in void context), it typically must be
350followed by a semicolon.  It's recommended therefore to use the style
351
352  step name =>
353    ensure { ... }
354    using { ... }
355    ;
356
357so as not to forget it.
358
359=item verbose SCALAR
360
361(Not exported by default.)  If true, will print output not only on
362failure of a step, but also at the beginning of a step (i.e., after
363the C<ensure> block is first run) indicating whether the condition
364failed ("Doing I<step name>") or succeeded ("Skipping I<step name>").
365Also prints a message ("Step I<step name> succeeded") if the C<ensure>
366condition now obtains after running C<using>.
367
368Whether or not C<verbose> is set, an exception will be thrown if the
369condition fails to obtain after running C<using>, with the message
370"Step I<step name> failed at line...".
371
372Besides using this subroutine, the environment variable
373I<GUARDED_VERBOSE> can also be used to control this behavior without
374modifying the code.  I<GUARDED_VERBOSE> will set the I<default>
375behavior of C<verbose>; when set to a true value, the script will run
376as if a C<verbose(1)> were specified at the beginning.  (A
377C<verbose(0)> will always disable verbosity, no matter the value of
378I<GUARDED_VERBOSE>.)
379
380=item clear_rollbacks
381
382(Not exported by default.)  Clears rollbacks.  See C<rollback> in the
383section B<BLOCKS> below.
384
385=back
386
387=head1 BLOCKS
388
389=over
390
391=item ensure BLOCK
392
393Defines a test for the step.  Should return true if the condition of
394the test has been met, false otherwise.  It's common to write ensure
395blocks as a chain of boolean expressions:
396
397  ensure { -d "$ENV{HOME}" and fgrep qr/^$userid:/, '/etc/passwd' }
398
399but it is also possible to use C<return> for more complicated tests:
400
401  ensure {
402    foreach my $dir (@dirs) {
403      return 0 unless -d $dir;
404    }
405    return 1
406  }
407
408A true return from C<ensure> will cause the script to continue
409execution.  A false return can have two possible effects: it will run
410the step's C<using> block, or, if the C<using> block has already been
411run, it will throw an exception.
412
413=item using BLOCK
414
415Defines the code to affect the condition in C<ensure>.  If the
416containing step's C<ensure> block returns a false value, BLOCK will be
417run.
418
419If the C<using> block is omitted, the step will work as a simple
420assertion: if the C<ensure> block returns a false value, an exception
421will be thrown.
422
423=item sanity BLOCK
424
425Defines a sanity check for a step.  Like C<ensure>, BLOCK should
426define a condition.  The condition is checked at the beginning of the
427enclosing step (prior to C<ensure>), and again after running the
428C<using> block (if the C<using> block is run, of course).  If it
429returns a false value, an exception is thrown with the message "Sanity
430check for I<step name> failed".
431
432Note given this behavior that a sanity check should specify an
433I<invariant> condition, i.e. something you expect to be true whether
434or not the step has run with success or failure.  For example:
435
436  step removeScratch =>
437    ensure { not fgrep qr|^\S*\s+/scratch|, '/etc/fstab' }
438    using { ... }
439    sanity { # Don't lose boot partition!
440      fgrep qr|^\S*\s+/boot\s|, '/etc/fstab'
441    }
442    ;
443
444=item rollback BLOCK
445
446Defines a rollback action for the step.  If this step, I<or any
447following step>, fails (either through C<ensure> verification or
448C<sanity> check failure), the rollback will be run.  If multiple
449rollbacks are defined, they will be run in LIFO (Last-In, First-Out)
450order.
451
452B<Warning>: if an exception (C<die> or C<croak>) is thrown in your
453rollback, the script will stop and other rollbacks will not be called.
454If you truly intend to abort all previously set rollbacks, you should
455use C<clear_rollbacks>.  You can (and probably should in most cases)
456call C<clear_rollbacks> itself from within a C<rollback> block:
457
458  step clearRollbacks =>
459    ensure { ... }
460    using { ... }
461    rollback {
462      clear_rollbacks;
463      ...
464    }
465    ;
466
467=back
468
469=head1 METHODS
470
471=over
472
473=item ->do
474
475=item ->do ARGS
476
477Executes a step, possibly with arguments.  If arguments are supplied,
478they will be passed to every block within the step.  Note that the
479arguments are read-only within the block (i.e., attempting to modify
480an element of @_ will throw an exception), though you can use
481C<shift>, etc.
482
483Some attempt is made to deal with return values, so you can get
484something approximating a reasonable result from C<do> when the
485C<using> block has executed.  But the author has not found a
486real-world need for return values, so their behavior is not very
487well-defined.  (Feel free to contact him if you believe you have a
488solution.)
489
490=item ->do_foreach LIST
491
492For each item of LIST, check C<ensure>, passing the item as an
493argument.  After all C<ensure>s have been run, run C<using> with those
494arguments whose C<ensure> failed.  Return values are not supported.
495At present, multiple arguments for each call are not supported, either
496(though you can certainly simulate that using a list-of-lists, if you
497write your blocks to take an arrayref).
498
499=back
500
501=head1 UTILITY SUBROUTINES
502
503These subroutines have nothing directly to do with the module, but
504they are so useful in conjunction with them, they have been included.
505
506=over
507
508=item fgrep REGEX, SCALAR
509
510Returns true if REGEX is found on any line of the file referenced by
511SCALAR.  SCALAR can be a filehandle variable (not a bare filehandle)
512or a string, in which case it is opened.  For instance:
513
514  die "Load too high"
515    unless fgrep qr/averages: 0[.]/, '/usr/bin/uptime|';
516
517Will throw an exception if the file cannot be opened for reading.
518
519=item readf FILENAME
520
521Returns a filehandle opened on FILENAME for reading.  Will throw an
522exception if the file cannot be opened for reading.
523
524=item writef FILENAME
525
526Returns a filehandle opened on FILENAME for writing.  Will throw an
527exception if the file cannot be opened for writing.
528
529=item appendf
530
531Returns a filehandle opened on FILENAME for appending.  Will throw an
532exception if the file cannot be opened for appending.
533
534=back
535
536=head1 RATIONALE
537
538People often intuitively refer to some sorts of executables as
539"scripts" and others as "programs."  When pressed for a definition,
540they will often fall back on language-specific criteria (such as
541whether the program is compiled or interpreted) that really do not
542capture the essence of the difference between scripting and more
543general-purpose programming.
544
545A I<script> generally differs from other programs in the following ways
546(there are exceptions):
547
548=over
549
550=item 1.
551
552It makes heavy use of the external environment in which it
553runs
554
555=item 2.
556
557It exports no complex data structures (though it may use them)
558
559=item 3.
560
561It has no outer event loop and does not daemonize (a simple
562interactive prompt loop does not count)
563
564=item 4.
565
566It is usually run by the author, the author's agent (I<cron>,
567etc.), or by a system administrator, rather than by the anonymous
568"user"
569
570=item 5.
571
572It has as its primary purpose ensuring that some desired state
573obtains in the system on which it runs (with "system" being defined as
574broadly as necessary).
575
576=back
577
578Much has been written on good programming methodology, but in general
579such methodologies have general-purpose programs in mind.  When
580applied to scripts, which are generally very high-level and procedural
581in nature, the methodologies can rapidly result in unreadable
582spaghetti, with more code devoted to methodology than to method.
583
584Most scripters react in one of two ways: they either let the spaghetti
585ensue, or they throw up their hands and write fragile code.
586
587=head2 An example
588
589Suppose you want to write a script to mount a scratch directory from
590an NFS server.  (This would usually be accomplished via a shell
591language such as I<bash>, but for the sake of argument let's suppose
592that you're writing in Perl, because you need access to another module
593or perhaps just because you like Perl better.)
594
595An optimistic implementation on a Red Hat Linux machine might be:
596
597  # Add mount to filesystem table
598  open FSTAB, ">>/etc/fstab";
599  print FSTAB "$source:$scratch /net/$source/$scratch nfs $mount_opts\n";
600  close FSTAB;
601  # Create mountpoint
602  mkdir $scratch;
603  # Symlink to /scratch
604  symlink "/net/$source/$scratch", '/scratch';
605  # Start NFS services automatically at boot
606  system "/sbin/chkconfig --level 3 portmap on";
607  system "/sbin/chkconfig --level 3 nfslock on";
608  # Start NFS services
609  system "/sbin/service portmap start";
610  system "/sbin/service nfslock start";
611  # Mount at boot time
612  system "/sbin/chkconfig --level 3 netfs on";
613  # Mount now
614  system "/sbin/service netfs start";
615
616With no error-checking at all, this script would blindly charge on
617oblivious to any problems.  If anything at all went wrong, the user
618would be left to pick up the pieces afterwards.  Running the script a
619second time could be perilous, as the print statement would continue
620to append to I</etc/fstab> even if it had previously succeeded.
621
622Good scripters will check for errors.  The most common response to
623such errors is to abort:
624
625  # Add mount to filesystem table
626  open FSTAB, ">>/etc/fstab"
627    or die "Can't open fstab for appending: $!\n";
628  print FSTAB "$source:$scratch /net/$source/$scratch nfs $mount_opts\n";
629  close FSTAB;
630  # Create mountpoint
631  mkdir $scratch
632    or die "Can't create directory $scratch: $!\n";
633  # Symlink to /scratch
634  symlink "/net/$source/$scratch", '/scratch'
635    or die "Can't make symlink to /scratch: $!\n";
636  # Start NFS services automatically at boot
637  system "/sbin/chkconfig --level 3 portmap on";
638  if ($?) {
639     die "Couldn't chkconfig on portmap\n";
640  }
641  system "/sbin/chkconfig --level 3 nfslock on";
642  if ($?) {
643     die "Couldn't chkconfig on nfslock\n";
644  }
645  # Start NFS services
646  system "/sbin/service portmap start";
647  if ($?) {
648     die "Couldn't start portmap\n";
649  }
650  system "/sbin/service nfslock start";
651  if ($?) {
652     die "Couldn't start nfslock\n";
653  }
654  # Mount at boot time
655  system "/sbin/chkconfig --level 3 netfs on";
656  if ($?) {
657     die "Couldn't start nfslock\n";
658  }
659  # Mount now
660  system "/sbin/service netfs start";
661  if ($?) {
662     die "Couldn't start netfs\n";
663  }
664
665This implementation is certainly less likely to cause weird results,
666but it is by no means perfect.  There are now nine places where the
667script may abnormally terminate, leaving the task incomplete and the
668user still to pick up the pieces.  If the script aborts early, the
669user may choose to try to fix the problem encountered and then
670manually revert to the initial state so that the script can be
671re-executed.
672
673But if the user misses any of the steps (say, deleting the line in
674I</etc/fstab>), the script will blithely carry on, unaware that some
675steps of the task are already done.  (Worse yet, the first response of
676many users to an unexpected error message is simply to try the command
677again.)
678
679If the script aborts late in the process, the user may try to fix the
680encountered problem and then finish the task manually.  This too, is
681fraught with peril--and the entire point of automating the task was to
682reduce the chance of operator error!
683
684One last observation about this new script--the functional code of the
685script has now been largely obscured by the error-checking code.  In a
686larger, more complicated script, the code could rapidly degenerate into
687an unreadable mass.
688
689Judicious use of a subroutine to factor out some of the error-checking
690improves readability somewhat:
691
692  sub doOrDie (@) {
693     system @_;
694     if ($?) {
695        die "Couldn't @_\n";
696     }
697  }
698  # Add mount to filesystem table
699  open FSTAB, ">>/etc/fstab"
700    or die "Can't open fstab for appending: $!\n";
701  print FSTAB "$source:$scratch /net/$source/$scratch nfs $mount_opts\n";
702  close FSTAB;
703  # Create mountpoint
704  mkdir $scratch
705    or die "Can't create directory $scratch: $!\n";
706  # Symlink to /scratch
707  symlink "/net/$source/$scratch", '/scratch'
708    or die "Can't make symlink to /scratch: $!\n";
709  # Start NFS services automatically at boot
710  doOrDie "/sbin/chkconfig --level 3 portmap on";
711  doOrDie "/sbin/chkconfig --level 3 nfslock on";
712  # Start NFS services
713  doOrDie "/sbin/service portmap start";
714  doOrDie "/sbin/service nfslock start";
715  # Mount at boot time
716  doOrDie "/sbin/chkconfig --level 3 netfs on";
717  # Mount now
718  doOrDie "/sbin/service netfs start";
719
720But suppose the system already had a preexisting mountpoint or
721symlink?  This hardly seems like good reason for the script to
722entirely fail.  The problem is that naive error-checking as above is
723I<syntactic> in basis--a result of conditions intrinsic to the
724implementation of the script--rather than being I<semantic>--i.e.,
725relating to the state the script is trying to bring about.
726
727=head2 Guarded commands to the rescue
728
729These observations have resulted in the development of this module.
730Using guarded commands, the script can be written more resiliently,
731more clearly, and in many cases, more easily.
732
733The first step in writing a script using guarded commands is to
734decompose the actions desired into a set of procedures, or I<steps>.
735The above script can be so decomposed by observing the comments
736marking each action of the script:
737
738  # Add mount to filesystem table
739  # Create mountpoint
740  # Symlink to /scratch
741  # Start NFS services automatically at boot
742  # Start NFS services
743  # Mount at boot time
744  # Mount now
745
746These are the script's steps.  (In this script, like many in system
747automation programming, the steps are strictly linear, with each
748dependent on one or more steps prior.  Some scripts will have more
749complicated dependencies, loops, conditionals and the like.)  For each
750step, one needs to define two things:
751
752=over
753
754=item 1.
755
756A I<necessary and sufficient> condition to judge whether the step has
757been completed.
758
759=item 2.
760
761Code that will cause that condition to come into being.
762
763=back
764
765To take the first step, "add mount to filesystem table," a necessary
766and sufficient condition can be expressed as
767
768  `cat /etc/fstab` =~ m|^$source:$scratch\s+/net/$source/$scratch|
769
770Note first that this check is I<semantic> in nature.  The code above
771would have created exactly one space between the two fields, but the
772regex allows for any amount of whitespace.  One might be tempted to
773write the condition as
774
775  `cat /etc/fstab` eq "$source:$scratch /net/$source/$scratch nfs $mount_opts\n"
776
777since that is the text that the script will be writing out.  But the
778script will be more resilient with the first condition, because it
779expresses exactly what later steps in the script I<need>, no
780more, no less: that I</etc/fstab> contain an entry that will cause the
781desired filesystem to be mounted in the desired place via NFS.
782If conditions change--for example, a new machine is preconfigured with
783a suitable I<fstab> entry--the script will continue to function.
784
785Having written the condition for the step--expressed in an C<ensure>
786block--the scripter then turns to how to bring the condition about.
787In this case, the code can be written
788
789  open my $fstab, ">>/etc/fstab";
790  print $fstab "$source:$scratch /net/$source/$scratch nfs $mount_opts";
791
792Note that we do not check the return value of C<open>.  There is no
793need.  If we fail to open I</etc/fstab>, the C<print> will fail.  If
794the C<print> fails, there will be no I<fstab> entry corresponding to
795the regex above, and the script will fail for want of having obtained
796the condition.  It may seem wrong at first--even blasphemous!--to
797willfully ignore the return value of a call like C<open>.  This is the
798first Lesson:
799
800=over
801
802=item B<Lesson 1.>
803
804Trust your conditions, and the rest will follow.
805
806=back
807
808The entire script, rewritten with guarded commands, looks like this:
809
810  use Commands::Guarded qw(:default fgrep appendf);
811
812  step "Add mount to filesystem table" =>
813    ensure { fgrep qr|^$source:$scratch\s+/net/$source/$scratch|,
814                   "/etc/fstab" }
815    using {
816       my $fstab = appendf '/etc/fstab';
817       print $fstab
818         "$source:$scratch /net/$source/$scratch nfs $mount_opts";
819    }
820    ;
821  step "Create mountpoint" =>
822    ensure { -d $scratch }
823    using { mkdir $scratch }
824    ;
825  step "Symlink to /scratch" =>
826    ensure { readlink '/scratch' eq  "/net/$source/$scratch" }
827    using { symlink "/net/$source/$scratch", '/scratch' }
828    ;
829  step "Start NFS services automatically at boot" =>
830    ensure {
831       fgrep qr/3:on/, '/sbin/chkconfig --list portmap|'
832         and fgrep qr/3:on/, '/sbin/chkconfig --list nfslock|';
833    }
834    using {
835       system "/sbin/chkconfig --level 3 portmap on";
836       system "/sbin/chkconfig --level 3 nfslock on";
837    }
838    ;
839  step "Start NFS services" =>
840    ensure {
841       fgrep qr/running/, "/sbin/service portmap status|"
842         and fgrep qr/running/, "/sbin/service nfslock status|";
843    }
844    using {
845       system "/sbin/service portmap start";
846       system "/sbin/service nfslock start";
847    }
848    ;
849  step "Mount at boot time" =>
850    ensure { fgrep qr/3:on/, '/sbin/chkconfig --list netfs|' }
851    using { system "/sbin/chkconfig --level 3 netfs on" }
852    ;
853  step "Mount now" =>
854    ensure { fgrep qr|^$source:$scratch\b|, 'df|' }
855    using { system "/sbin/service netfs start" }
856    ;
857
858With guarded commands, this script has numerous advantages over the
859previous ones:
860
861=over
862
863=item *
864
865It is more B<resilient>.  Because its checks are semantic in nature,
866the script will react properly to minor changes in the environment
867that would derail a conventionally written script.
868
869=item *
870
871If it fails due to some unforeseen problem, it can be rerun once the
872problem has been fixed.  It will automatically pick up exactly where
873it left off.
874
875=item *
876
877Not only can this script be used to cause the intended state to come
878into being (in this case, mounting the scratch filesystem), it can be
879used to I<verify> that the state exists. If it exits without failure,
880then the desired state is verified.
881
882It would be perfectly reasonable, for instance, to include the above
883script in a I<crontab> entry run periodically.  If something went
884awry--e.g., the directory were unmounted or I<portmap> was removed
885from the init list--the script would notice this problem and repair
886it.
887
888=item *
889
890Only I<important> tests--the semantic ones--need to be written.  There
891is no need to check every possible error condition of every line of
892code.
893
894=item *
895
896The error-checking code and the running code are held together in a
897single C<step> command, but are separated into C<ensure> and C<using>
898blocks.  This results in a more readable script without error-checking
899spaghetti.
900
901=back
902
903=over
904
905=item B<Lesson 2.>
906
907With guarded commands, you can afford to be audacious.
908
909=back
910
911If I<every> line of code in a script that has a side effect is put
912into C<using> blocks, the script becomes much less dangerous.  There
913is a smaller chance that the script will "run away" and do something
914unexpected and horrible.  Each step is checked after a C<using> block
915is run, and so long as your semantic tests are correct, the script
916will halt if things start to go awry.
917
918=over
919
920=item B<Lesson 3.>
921
922Take note of idempotence, and turn it to your advantage.
923
924=back
925
926A function I<f> is I<idempotent> if it has the property
927
928=over
929
930I<f>(I<f>(I<x>)) = I<f>(I<x>)
931
932=back
933
934in other words, something is idempotent if doing it twice has the same
935effect as doing it once.  Many UNIX tools have the property of
936idempotence: I<ln -f>, I<cp>, and I<rsync> are three examples.  (Some
937tools look like they're idempotent but aren't, e.g. I<mount>: you can
938mount the same filesystem twice on the "same", overlapping
939mountpoints.)
940
941Idempotence is a large part of the power of Commands::Guarded.  If you
942put every expression with side-effects (or, more precisely, side
943effects that will persist beyond the life of the script, e.g. writing
944files) into a C<using> block, each successful step in the script becomes
945idempotent.  In turn, a script that completes successfully is also
946idempotent: you can run it again and it should change nothing.
947
948Knowing about idempotence can help you in writing your C<ensure> and
949C<using> blocks.  For instance, the step above
950
951  step "Start NFS services automatically at boot" =>
952    ensure {
953       fgrep qr/3:on/, '/sbin/chkconfig --list portmap|'
954         and fgrep qr/3:on/, '/sbin/chkconfig --list nfslock|';
955    }
956    using {
957       system "/sbin/chkconfig --level 3 portmap on";
958       system "/sbin/chkconfig --level 3 nfslock on";
959    }
960    ;
961
962Has been made simpler by noting the idempotence of I<chkconfig>.  It's
963possible that I<portmap> is already enabled but <nfslock> is not,
964causing the C<ensure> to fail.  But because the I<chkconfig>
965statements in the C<using> block are idempotent, it is safe to run the
966line
967
968       system "/sbin/chkconfig --level 3 portmap on";
969
970again, even if I<portmap> is already enabled.
971
972=head1 EXPORTS
973
974By default, C<step>, C<ensure>, and C<using>.
975
976The following import tags can be used:
977
978=over
979
980=item C<:step> (or C<:default>)
981
982Imports the default subs of C<step>, C<ensure>, C<using>, C<sanity>,
983and C<rollback>.  This is also what you get if you just say
984
985  use Commands::Guarded;
986
987but you will need to use one of these tags if you import another tag
988or named sub.
989
990=item C<:utils>
991
992Imports C<fgrep>, C<readf>, C<writef>, and C<appendf>.
993
994=back
995
996=head1 SEE ALSO
997
998E. W. Dijkstra, "Guarded commands, nondeterminacy and formal
999derivation of programs," I<Communications of the ACM>, Vol. 18, No. 8,
10001975, pp. 453-458.  Describes guarded commands in a fundamentally
1001different form than implemented in this module.
1002
1003This module was first presented in an Invited Talk at the 18th Annual
1004System Administration Conference, Atlanta, 18 Nov 2004, sponsored by
1005SAGE L<http://www.sage.org/> and USENIX L<http://www.usenix.org/>.
1006See L<http://www.usenix.org/events/lisa04/>.  (Please note that
1007because this was an Invited Talk, information is not included in the
1008proceedings of that conference.)
1009
1010=head1 TODO
1011
1012=over
1013
1014=item *
1015
1016A method to selectively clear rollbacks.  This is complicated because
1017the same rollback codeblock might be registered several times with
1018different arguments using C<do(ARGS)>.
1019
1020=item *
1021
1022Rational behavior when C<ensure> is omitted.  Today it just throws an
1023error.
1024
1025=item *
1026
1027A reasonable way to extend and subclass.  You could do it today, but
1028it would be relatively tough--which is why it's not documented.
1029
1030=back
1031
1032=head1 SOURCE REPOSITORY
1033
1034The source is available via git at L<http://github.com/treyharris/Commands-Guarded/>.
1035
1036=head1 ACKNOWLEDGMENTS
1037
1038I would like to thank Damian Conway for his invaluable assistance on
1039this module, including on naming of the constructs and the module
1040itself, and for pointing out to me Dijkstra's prior work.
1041
1042Thanks and love to J.D., for keeping me sane.  As sane as I ever am,
1043anyway.
1044
1045=head1 AUTHOR
1046
1047Trey Harris, E<lt>treyharris@gmail.comE<gt>
1048
1049=head1 COPYRIGHT AND LICENSE
1050
1051Copyright 2004-2009 by Trey Harris
1052
1053This library is free software; you can redistribute it and/or modify
1054it under the same terms as Perl itself.
1055
1056=cut
1057