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