src/libuafs/afsload/lib/AFS/Load/Action.pm

   1 package AFS::Load::Action;
   2 use strict;
   3 use POSIX;
   4
   5 =head1 NAME
   6
   7 AFS::Load::Action - test actions for afsload
   8
   9 =head1 SYNOPSIS
  10
  11   step
  12       node * chdir "/afs/localcell/afsload"
  13   step
  14       node 0 creat file1 "file 1 contents"
  15       node 1 creat file2 "file 2 contents"
  16   step
  17       node * read file1 "file 1 contents"
  18       node * read file2 "file 2 contents"
  19   step
  20       node 0 unlink file1
  21       node 1 unlink file2
  22
  23 =head1 DESCRIPTION
  24
  25 This module and submodule defines the actions that can be specified in an
  26 afsload test configuration file. The name of each action is the first thing
  27 that appears after the 'node' directive and the node range specification.
  28 Everything after the action name are the arguments for that action, which
  29 are different for every action.
  30
  31 Each action is implemented as a small module in AFS::Load::Action::<name>,
  32 where <name> is the name of the action. So, to implement a new action, simply
  33 copy an existing action into a new module, and change the code.
  34
  35 Each action typically performs one filesystem operation, or a small series of
  36 filesystem operations forming one logical operation. Each action may succeed
  37 or fail; in the case of a failure an action provides an error code and
  38 optionally an error string. In many cases the error code is the resultant
  39 errno value for a filesystem operation, but that is not necessary; errno is
  40 even recorded and reported separately in the case of a failure in case it is
  41 relevant and different from the given error code.
  42
  43 The rest of this documentation just covers what each action does, and how to
  44 use each one.
  45
  46 =cut
  47
  48 sub _interpret_impl($) {
  49         my $name = shift;
  50         my $class = "AFS::Load::Action::$name";
  51         if ($class->can('new')) {
  52                 return $class;
  53         }
  54         die("Unknown action '$name' in configuration");
  55 }
  56
  57 sub parse($$$@) {
  58         my $proto = shift;
  59         my $nAct = shift;
  60
  61         my $implname = shift;
  62         my $impl = _interpret_impl($implname);
  63
  64         my $ret = $impl->new(@_);
  65         $ret->{NACT} = $nAct;
  66
  67         return $ret;
  68 }
  69
  70 sub new($$) {
  71         my $proto = shift;
  72         my $class = ref($proto) || $proto;
  73         my $self = {};
  74         bless $self, $class;
  75         return $self;
  76 }
  77
  78 sub do($) {
  79         my $self = shift;
  80         my @ret = $self->doact();
  81         return @ret;
  82 }
  83
  84 1;
  85
  86 =head1 chdir
  87
  88 =head2 EXAMPLE
  89
  90   step
  91       node * chdir /afs/localcell/afsload
  92
  93 =head2 DESCRIPTION
  94
  95 The C<chdir> action just changes the working directory for the specified client
  96 node. Using this and specifying paths in other actions as short, relative paths
  97 can make the test configuration easier to read and write.
  98
  99 =head2 ARGUMENTS
 100
 101 The only argument is the directory to chdir to.
 102
 103 =head2 ERRORS
 104
 105 The same errors as the uafs_chdir() call, which should be the same errors as
 106 you might expect from a regular chdir() call.
 107
 108 =cut
 109
 110 package AFS::Load::Action::chdir;
 111 use strict;
 112 use AFS::Load::Action;
 113 use AFS::ukernel;
 114 our @ISA = ("AFS::Load::Action");
 115
 116 sub new {
 117         my $proto = shift;
 118         my $class = ref($proto) || $proto;
 119         my $self = $class->SUPER::new();
 120
 121         bless($self, $class);
 122
 123         my $args = $#_ + 1;
 124         if ($args != 1) {
 125                 die("wrong number of args ($args) to chdir (should be 1)");
 126         }
 127         $self->{DIR} = $_[0];
 128
 129         return $self;
 130 }
 131
 132 sub doact($) {
 133         my $self = shift;
 134         my $code = AFS::ukernel::uafs_chdir($self->{DIR});
 135         if ($code) {
 136                 return (int($!), '');
 137         }
 138         return (0,0);
 139 }
 140
 141 sub str($) {
 142         my $self = shift;
 143         return "chdir($self->{DIR})";
 144 }
 145
 146 1;
 147
 148 =head1 creat
 149
 150 =head2 EXAMPLE
 151
 152   step
 153       node 0 creat file1 "file1 contents"
 154
 155 =head2 DESCRIPTION
 156
 157 Creates a file with the given filename with the given contents.
 158
 159 =head2 ARGUMENTS
 160
 161 The first argument is the file name to create, and the second argument is the
 162 contents to write to the newly-created file.
 163
 164 =head2 ERRORS
 165
 166 Any error generated by uafs_open() or uafs_write() will cause an error. An
 167 error will be generated if the file already exists.
 168
 169 =cut
 170
 171 package AFS::Load::Action::creat;
 172 use strict;
 173 use AFS::Load::Action;
 174 use AFS::ukernel;
 175 our @ISA = ("AFS::Load::Action");
 176
 177 sub new {
 178         my $proto = shift;
 179         my $class = ref($proto) || $proto;
 180         my $self = $class->SUPER::new();
 181
 182         bless($self, $class);
 183
 184         my $args = $#_ + 1;
 185         if ($args != 2) {
 186                 die("wrong number of args ($args) to creat (should be 2)");
 187         }
 188         $self->{FILE} = $_[0];
 189         $self->{DATA} = $_[1];
 190
 191         return $self;
 192 }
 193
 194 sub doact($) {
 195         my $self = shift;
 196         my $fd = AFS::ukernel::uafs_open($self->{FILE},
 197                                          POSIX::O_CREAT | POSIX::O_EXCL | POSIX::O_WRONLY,
 198                                          0644);
 199         if ($fd < 0) {
 200                 return (int($!), 'open error');
 201         }
 202
 203         my $code = AFS::ukernel::uafs_write($fd, $self->{DATA});
 204         if ($code < 0) {
 205                 my $errno_save = int($!);
 206                 AFS::ukernel::uafs_close($fd);
 207                 return ($errno_save, 'write error');
 208         }
 209
 210         AFS::ukernel::uafs_close($fd);
 211
 212         return (0,0);
 213 }
 214
 215 sub str($) {
 216         my $self = shift;
 217         return "creat($self->{FILE})";
 218 }
 219
 220 1;
 221
 222 =head1 read
 223
 224 =head2 EXAMPLE
 225
 226   step
 227       node 0 read file1 "file1 contents"
 228
 229 =head2 DESCRIPTION
 230
 231 Opens and reads a file and verifies that the file contains certain contents.
 232
 233 =head2 ARGUMENTS
 234
 235 The first argument is the file name to read, and the second argument is the
 236 expected contents of the file.
 237
 238 =head2 ERRORS
 239
 240 Any error generated by the underlying filesystem ops will cause an error. An
 241 error will also be generated if the file has contents different than what was
 242 specified or has a different length than the given string. In which case, what
 243 was actually in the file up to the length in the given string will be reported
 244 in the error message.
 245
 246 =cut
 247
 248 package AFS::Load::Action::read;
 249 use strict;
 250 use AFS::Load::Action;
 251 use AFS::ukernel;
 252 our @ISA = ("AFS::Load::Action");
 253
 254 sub new {
 255         my $proto = shift;
 256         my $class = ref($proto) || $proto;
 257         my $self = $class->SUPER::new();
 258
 259         bless($self, $class);
 260
 261         my $args = $#_ + 1;
 262         if ($args != 2) {
 263                 die("wrong number of args ($args) to read (should be 2)");
 264         }
 265         $self->{FILE} = $_[0];
 266         $self->{DATA} = $_[1];
 267
 268         return $self;
 269 }
 270
 271 sub doact($) {
 272         my $self = shift;
 273         my $code;
 274         my $str;
 275         my @stat;
 276         my $fd = AFS::ukernel::uafs_open($self->{FILE},
 277                                          POSIX::O_RDONLY,
 278                                          0644);
 279         if ($fd < 0) {
 280                 return (int($!), 'open error');
 281         }
 282
 283         ($code, @stat) = AFS::ukernel::uafs_fstat($fd);
 284         if ($code < 0) {
 285                 my $errno_save = int($!);
 286                 AFS::ukernel::uafs_close($fd);
 287                 return ($errno_save, 'fstat error');
 288         }
 289
 290         ($code, $str) = AFS::ukernel::uafs_read($fd, length $self->{DATA});
 291         if ($code < 0) {
 292                 my $errno_save = int($!);
 293                 AFS::ukernel::uafs_close($fd);
 294                 return ($errno_save, 'read error');
 295         }
 296
 297         AFS::ukernel::uafs_close($fd);
 298
 299         if ($str ne $self->{DATA}) {
 300                 my $lenstr = '';
 301                 if ($stat[7] != length $self->{DATA}) {
 302                         $lenstr = " (total length $stat[7])";
 303                 }
 304                 return (-1, "got: $str$lenstr, expected: $self->{DATA}");
 305         }
 306
 307         if ($stat[7] != length $self->{DATA}) {
 308                 return (-1, "got file size: $stat[7], expected: ".(length $self->{DATA}));
 309         }
 310
 311         return (0,0);
 312 }
 313
 314 sub str($) {
 315         my $self = shift;
 316         return "read($self->{FILE})";
 317 }
 318
 319 1;
 320
 321 =head1 cat
 322
 323 =head2 EXAMPLE
 324
 325   step
 326       node 0 cat file1 file2
 327
 328 =head2 DESCRIPTION
 329
 330 Opens and reads the entire contents of all specified files, discarding any
 331 read data.
 332
 333 =head2 ARGUMENTS
 334
 335 The argument list is a list of files to read.
 336
 337 =head2 ERRORS
 338
 339 Any error generated by the underlying filesystem ops will cause an error.
 340 When an error occurs on reading one file, subsequent files will still be
 341 attempted to be read, but an error will still be returned afterwards.
 342
 343 =cut
 344
 345 package AFS::Load::Action::cat;
 346 use strict;
 347 use AFS::Load::Action;
 348 use AFS::ukernel;
 349 our @ISA = ("AFS::Load::Action");
 350
 351 sub new {
 352         my $proto = shift;
 353         my $class = ref($proto) || $proto;
 354         my $self = $class->SUPER::new();
 355
 356         bless($self, $class);
 357
 358         my $args = $#_ + 1;
 359         if ($args < 1) {
 360                 die("wrong number of args ($args) to cat (should be at least 1)");
 361         }
 362         $self->{FILES} = [@_,];
 363
 364         return $self;
 365 }
 366
 367 sub doact($) {
 368         my $self = shift;
 369         my $code;
 370         my $err = 0;
 371         my $errstr = '';
 372         my $files = $self->{FILES};
 373
 374         for my $file (@$files) {
 375                 my $str;
 376                 my $fd = AFS::ukernel::uafs_open($file,
 377                                                  POSIX::O_RDONLY,
 378                                                  0644);
 379                 if ($fd < 0) {
 380                         if ($err == 0) {
 381                                 $err = int($!);
 382                         }
 383                         $errstr .= "$file: open error\n";
 384                         next;
 385                 }
 386
 387                 $code = 1;
 388                 while ($code > 0) {
 389                         ($code, $str) = AFS::ukernel::uafs_read($fd, 16384);
 390                         if ($code < 0) {
 391                                 if ($err == 0) {
 392                                         $err = int($!);
 393                                 }
 394                                 $errstr .= "$file: read error\n";
 395                         }
 396                 }
 397                 $str = undef;
 398
 399                 AFS::ukernel::uafs_close($fd);
 400         }
 401
 402         if ($errstr) {
 403                 return (-1, $errstr);
 404         }
 405
 406         return (0,0);
 407 }
 408
 409 sub str($) {
 410         my $self = shift;
 411         my $files = $self->{FILES};
 412         return "cat(".join(',', @$files).")";
 413 }
 414
 415 1;
 416
 417 =head1 cp
 418
 419 =head2 EXAMPLE
 420
 421   step
 422       node 0 cp 10M /dev/urandom foo.urandom
 423
 424 =head2 DESCRIPTION
 425
 426 Copies file data up to a certain amount.
 427
 428 =head2 ARGUMENTS
 429
 430 The first argument is the maximum amount of data to copy. It is a number of
 431 bytes, optionally followed by a size suffix: K, M, G, or T. You can specify
 432 -1 or "ALL" to copy until EOF on the source is encountered.
 433
 434 The second argument is the file to copy data out of. The third argument is the
 435 destination file to copy into. The destination file may or may not exist; if it
 436 exists, it is truncated before copying data.
 437
 438 Either file may be a file on local disk, but at least one must be in AFS. The
 439 file will be treated as a file on local disk only if it starts with a leading
 440 slash, and does not start with /afs/.
 441
 442 =head2 ERRORS
 443
 444 Any error generated by the underlying filesystem ops will cause an error.
 445
 446 =cut
 447
 448 package AFS::Load::Action::cp;
 449
 450 use strict;
 451
 452 use Number::Format qw(round unformat_number);
 453
 454 use AFS::Load::Action;
 455 use AFS::ukernel;
 456 our @ISA = ("AFS::Load::Action");
 457
 458 sub new {
 459         my $proto = shift;
 460         my $class = ref($proto) || $proto;
 461         my $self = $class->SUPER::new();
 462
 463         bless($self, $class);
 464
 465         my $args = $#_ + 1;
 466         if ($args != 3) {
 467                 die("wrong number of args ($args) to cp (should be 3)");
 468         }
 469
 470         my $len = shift;
 471         $self->{SRC} = shift;
 472         $self->{DST} = shift;
 473
 474         $len = uc($len);
 475         if ($len eq "ALL") {
 476                 $self->{LEN} = -1;
 477         } else {
 478                 $self->{LEN} = round(unformat_number($len), 0);
 479                 if (not $self->{LEN}) {
 480                         die("Invalid format ($len) given to cp");
 481                 }
 482         }
 483
 484         return $self;
 485 }
 486
 487 sub _isafs($) {
 488         my $str = shift;
 489         if ($str =~ m:^([^/]|/afs/):) {
 490                 # assume relative paths are in AFS
 491                 # and of course anything starting with /afs/ is in AFS
 492                 return 1;
 493         }
 494         return 0;
 495 }
 496
 497 sub _cpin_sysread($$) {
 498         my ($inh, $len) = @_;
 499         my $buf;
 500         my $bytes = sysread($inh, $buf, $len);
 501
 502         if (defined($bytes)) {
 503                 return ($bytes, $buf);
 504         }
 505         return (-1, undef);
 506 }
 507
 508 sub _cpout_syswrite($$) {
 509         my ($outh, $str) = @_;
 510         my $code;
 511         $code = syswrite($outh, $str, length $str);
 512
 513         if (defined($code)) {
 514                 return $code;
 515         }
 516         return -1;
 517 }
 518
 519 sub _cp_close($) {
 520         my $fh = shift;
 521         if (close($fh)) {
 522                 return 0;
 523         }
 524         return -1;
 525 }
 526
 527 sub doact($) {
 528         my $self = shift;
 529         my $code;
 530         my $err = 0;
 531         my $errstr = '';
 532
 533         my $inh;
 534         my $outh;
 535         my $readf;
 536         my $writef;
 537         my $inclosef;
 538         my $outclosef;
 539
 540         if (_isafs($self->{SRC})) {
 541                 $inh = AFS::ukernel::uafs_open($self->{SRC}, POSIX::O_RDONLY, 0644);
 542                 if ($inh < 0) {
 543                         return (int($!), "input open error (AFS)");
 544                 }
 545
 546                 $readf = \&AFS::ukernel::uafs_read;
 547                 $inclosef = \&AFS::ukernel::uafs_close;
 548         } else{
 549                 open($inh, "< $self->{SRC}") or
 550                         return (int($!), "input open error (local)");
 551
 552                 $readf = \&_cpin_sysread;
 553                 $inclosef = \&_cp_close;
 554         }
 555
 556         if (_isafs($self->{DST})) {
 557                 $outh = AFS::ukernel::uafs_open($self->{DST},
 558                                                 POSIX::O_WRONLY | POSIX::O_TRUNC | POSIX::O_CREAT,
 559                                                 0644);
 560                 if ($outh < 0) {
 561                         return (int($!), "output open error (AFS)");
 562                 }
 563                 $writef = \&AFS::ukernel::uafs_write;
 564                 $outclosef = \&AFS::ukernel::uafs_close;
 565         } else {
 566                 open($outh, "> $self->{DST}") or
 567                         return (int($!), "output open error(local)");
 568                 $writef = \&_cpout_syswrite;
 569                 $outclosef = \&_cp_close;
 570         }
 571
 572         my $str;
 573         my $remaining = $self->{LEN};
 574         while ($remaining) {
 575
 576                 my $len = 16384;
 577                 my $rbytes;
 578                 my $wbytes;
 579
 580                 if ($remaining > 0 && $remaining < $len) {
 581                         $len = $remaining;
 582                 }
 583
 584                 ($rbytes, $str) = &$readf($inh, $len);
 585                 if ($rbytes < 0) {
 586                         my $errno_save = int($!);
 587
 588                         &$inclosef($inh);
 589                         &$outclosef($outh);
 590
 591                         return ($errno_save, "read error");
 592                 }
 593
 594                 if ($rbytes == 0) {
 595                         last;
 596                 }
 597
 598                 $wbytes = &$writef($outh, $str);
 599                 if ($wbytes != $rbytes) {
 600                         my $errno_save = int($!);
 601
 602                         &$inclosef($inh);
 603                         &$outclosef($outh);
 604
 605                         return ($errno_save, "write error ($wbytes/$rbytes)");
 606                 }
 607
 608                 if ($remaining > 0) {
 609                         $remaining -= $rbytes;
 610                 }
 611         }
 612
 613         &$inclosef($inh);
 614         if (&$outclosef($outh) != 0) {
 615                 return (int($!), "close error");
 616         }
 617
 618         return (0,0);
 619 }
 620
 621 sub str($) {
 622         my $self = shift;
 623         return "cp(".join(',', $self->{LEN}, $self->{SRC}, $self->{DST}).")";
 624 }
 625
 626 1;
 627
 628 =head1 truncwrite
 629
 630 =head2 EXAMPLE
 631
 632   step
 633       node 0 truncwrite file1 "different contents"
 634
 635 =head2 DESCRIPTION
 636
 637 Opens and truncates an existing file, then writes some data to it.
 638
 639 =head2 ARGUMENTS
 640
 641 The first argument is the file name to open and truncate, and the second
 642 argument is the data to write to the file.
 643
 644 =head2 ERRORS
 645
 646 Any error generated by the underlying filesystem ops will cause an error. Note
 647 that the file must already exist for this to succeed.
 648
 649 =cut
 650
 651 package AFS::Load::Action::truncwrite;
 652 use strict;
 653 use AFS::Load::Action;
 654 use AFS::ukernel;
 655 our @ISA = ("AFS::Load::Action");
 656
 657 sub new {
 658         my $proto = shift;
 659         my $class = ref($proto) || $proto;
 660         my $self = $class->SUPER::new();
 661
 662         bless($self, $class);
 663
 664         my $args = $#_ + 1;
 665         if ($args != 2) {
 666                 die("wrong number of args ($args) to truncwrite (should be 2)");
 667         }
 668         $self->{FILE} = $_[0];
 669         $self->{DATA} = $_[1];
 670
 671         return $self;
 672 }
 673
 674 sub doact($) {
 675         my $self = shift;
 676         my $fd = AFS::ukernel::uafs_open($self->{FILE},
 677                                          POSIX::O_WRONLY | POSIX::O_TRUNC,
 678                                          0644);
 679         if ($fd < 0) {
 680                 return (int($!), 'open error');
 681         }
 682
 683         my ($code) = AFS::ukernel::uafs_write($fd, $self->{DATA});
 684         if ($code < 0) {
 685                 my $errno_save = int($!);
 686                 AFS::ukernel::uafs_close($fd);
 687                 return ($errno_save, 'write error');
 688         }
 689
 690         AFS::ukernel::uafs_close($fd);
 691
 692         if ($code eq length $self->{DATA}) {
 693                 return (0,0);
 694         }
 695
 696         return (-1, "got: $code bytes written, expected: ".(length $self->{DATA}));
 697 }
 698
 699 sub str($) {
 700         my $self = shift;
 701         return "truncwrite($self->{FILE}, $self->{DATA})";
 702 }
 703
 704 1;
 705
 706 =head1 append
 707
 708 =head2 EXAMPLE
 709
 710   step
 711       node 0 append file1 "more data"
 712
 713 =head2 DESCRIPTION
 714
 715 Opens an existing file, and appends some data to it.
 716
 717 =head2 ARGUMENTS
 718
 719 The first argument is the file name to open, and the second argument is the
 720 data to append to the file.
 721
 722 =head2 ERRORS
 723
 724 Any error generated by the underlying filesystem ops will cause an error. Note
 725 that the file must already exist for this to succeed.
 726
 727 =cut
 728
 729 package AFS::Load::Action::append;
 730 use strict;
 731 use AFS::Load::Action;
 732 use AFS::ukernel;
 733 our @ISA = ("AFS::Load::Action");
 734
 735 sub new {
 736         my $proto = shift;
 737         my $class = ref($proto) || $proto;
 738         my $self = $class->SUPER::new();
 739
 740         bless($self, $class);
 741
 742         my $args = $#_ + 1;
 743         if ($args != 2) {
 744                 die("wrong number of args ($args) to append (should be 2)");
 745         }
 746         $self->{FILE} = $_[0];
 747         $self->{DATA} = $_[1];
 748
 749         return $self;
 750 }
 751
 752 sub doact($) {
 753         my $self = shift;
 754         my $fd = AFS::ukernel::uafs_open($self->{FILE},
 755                                          POSIX::O_WRONLY | POSIX::O_APPEND,
 756                                          0644);
 757         if ($fd < 0) {
 758                 return (int($!), 'open error');
 759         }
 760
 761         my ($code) = AFS::ukernel::uafs_write($fd, $self->{DATA});
 762         if ($code < 0) {
 763                 my $errno_save = int($!);
 764                 AFS::ukernel::uafs_close($fd);
 765                 return ($errno_save, 'write error');
 766         }
 767
 768         AFS::ukernel::uafs_close($fd);
 769
 770         if ($code eq length $self->{DATA}) {
 771                 return (0,0);
 772         }
 773
 774         return (-1, "got: $code bytes written, expected: ".(length $self->{DATA}));
 775 }
 776
 777 sub str($) {
 778         my $self = shift;
 779         return "append($self->{FILE}, $self->{DATA})";
 780 }
 781
 782 1;
 783
 784 =head1 unlink
 785
 786 =head2 EXAMPLE
 787
 788   step
 789       node 0 unlink file1 [file2] ... [fileN]
 790
 791 =head2 DESCRIPTION
 792
 793 Unlinks the specified file(s).
 794
 795 =head2 ARGUMENTS
 796
 797 All arguments are files to unlink.
 798
 799 =head2 ERRORS
 800
 801 Any error generated by the underlying uafs_unlink() call. An error will be
 802 returned if unlinking any file generates an error, but we will attempt to
 803 unlink all specified files.
 804
 805 =cut
 806
 807 package AFS::Load::Action::unlink;
 808 use strict;
 809 use AFS::Load::Action;
 810 use AFS::ukernel;
 811 our @ISA = ("AFS::Load::Action");
 812
 813 sub new {
 814         my $proto = shift;
 815         my $class = ref($proto) || $proto;
 816         my $self = $class->SUPER::new();
 817
 818         bless($self, $class);
 819
 820         my $args = $#_ + 1;
 821         if ($args < 1) {
 822                 die("wrong number of args ($args) to unlink (should be at least 1)");
 823         }
 824         $self->{FILES} = [@_];
 825
 826         return $self;
 827 }
 828
 829 sub doact($) {
 830         my $self = shift;
 831         my $ret = 0;
 832         my @errfiles = ();
 833         my $files = $self->{FILES};
 834
 835         for my $file (@$files) {
 836                 my $code = AFS::ukernel::uafs_unlink($file);
 837                 if ($code) {
 838                         if (not length(@errfiles)) {
 839                                 $ret = int($!);
 840                         }
 841                         push(@errfiles, $file);
 842                 }
 843         }
 844
 845         if (@errfiles) {
 846                 return ($ret, join(', ', @errfiles));
 847         }
 848         return (0,0);
 849 }
 850
 851 sub str($) {
 852         my $self = shift;
 853         my $files = $self->{FILES};
 854         return "unlink(".(join(',', @$files)).")";
 855 }
 856
 857 1;
 858
 859 =head1 rename
 860
 861 =head2 EXAMPLE
 862
 863   step
 864       node 0 rename file1 file2
 865
 866 =head2 DESCRIPTION
 867
 868 Renames a file within a volume.
 869
 870 =head2 ARGUMENTS
 871
 872 The first argument is the file to move, and the second argument is the new
 873 name to move it to.
 874
 875 =head2 ERRORS
 876
 877 Any error generated by the underlying uafs_rename() call.
 878
 879 =cut
 880
 881 package AFS::Load::Action::rename;
 882 use strict;
 883 use AFS::Load::Action;
 884 use AFS::ukernel;
 885 our @ISA = ("AFS::Load::Action");
 886
 887 sub new {
 888         my $proto = shift;
 889         my $class = ref($proto) || $proto;
 890         my $self = $class->SUPER::new();
 891
 892         bless($self, $class);
 893
 894         my $args = $#_ + 1;
 895         if ($args != 2) {
 896                 die("wrong number of args ($args) to rename (should be 2)");
 897         }
 898         $self->{SRC} = $_[0];
 899         $self->{DST} = $_[1];
 900
 901         return $self;
 902 }
 903
 904 sub doact($) {
 905         my $self = shift;
 906         my $code = AFS::ukernel::uafs_rename($self->{SRC}, $self->{DST});
 907         if ($code) {
 908                 return (int($!), '');
 909         }
 910         return (0,0);
 911 }
 912
 913 sub str($) {
 914         my $self = shift;
 915         return "rename($self->{SRC}, $self->{DST})";
 916 }
 917
 918 1;
 919
 920 =head1 hlink
 921
 922 =head2 EXAMPLE
 923
 924   step
 925       node 0 hlink file1 file2
 926
 927 =head2 DESCRIPTION
 928
 929 Hard-links a file within a directory.
 930
 931 =head2 ARGUMENTS
 932
 933 The first argument is the source file, and the second argument is the name of
 934 the new hard link.
 935
 936 =head2 ERRORS
 937
 938 Any error generated by the underlying uafs_link() call.
 939
 940 =cut
 941
 942 package AFS::Load::Action::hlink;
 943 use strict;
 944 use AFS::Load::Action;
 945 use AFS::ukernel;
 946 our @ISA = ("AFS::Load::Action");
 947
 948 sub new {
 949         my $proto = shift;
 950         my $class = ref($proto) || $proto;
 951         my $self = $class->SUPER::new();
 952
 953         bless($self, $class);
 954
 955         my $args = $#_ + 1;
 956         if ($args != 2) {
 957                 die("wrong number of args ($args) to hlink (should be 2)");
 958         }
 959         $self->{SRC} = $_[0];
 960         $self->{DST} = $_[1];
 961
 962         return $self;
 963 }
 964
 965 sub doact($) {
 966         my $self = shift;
 967         my $code = AFS::ukernel::uafs_link($self->{SRC}, $self->{DST});
 968         if ($code) {
 969                 return (int($!), '');
 970         }
 971         return (0,0);
 972 }
 973
 974 sub str($) {
 975         my $self = shift;
 976         return "hlink($self->{SRC}, $self->{DST})";
 977 }
 978
 979 1;
 980
 981 =head1 slink
 982
 983 =head2 EXAMPLE
 984
 985   step
 986       node 0 slink file1 file2
 987
 988 =head2 DESCRIPTION
 989
 990 Symlinks a file within a directory.
 991
 992 =head2 ARGUMENTS
 993
 994 The first argument is the source file, and the second argument is the name of
 995 the new symlink.
 996
 997 =head2 ERRORS
 998
 999 Any error generated by the underlying uafs_symlink() call.
1000
1001 =cut
1002
1003 package AFS::Load::Action::slink;
1004 use strict;
1005 use AFS::Load::Action;
1006 use AFS::ukernel;
1007 our @ISA = ("AFS::Load::Action");
1008
1009 sub new {
1010         my $proto = shift;
1011         my $class = ref($proto) || $proto;
1012         my $self = $class->SUPER::new();
1013
1014         bless($self, $class);
1015
1016         my $args = $#_ + 1;
1017         if ($args != 2) {
1018                 die("wrong number of args ($args) to slink (should be 2)");
1019         }
1020         $self->{SRC} = $_[0];
1021         $self->{DST} = $_[1];
1022
1023         return $self;
1024 }
1025
1026 sub doact($) {
1027         my $self = shift;
1028         my $code = AFS::ukernel::uafs_symlink($self->{SRC}, $self->{DST});
1029         if ($code) {
1030                 return (int($!), '');
1031         }
1032         return (0,0);
1033 }
1034
1035 sub str($) {
1036         my $self = shift;
1037         return "slink($self->{SRC}, $self->{DST})";
1038 }
1039
1040 1;
1041
1042 =head1 access_r
1043
1044 =head2 EXAMPLE
1045
1046   step
1047       node 0 access_r file1
1048
1049 =head2 DESCRIPTION
1050
1051 Verifies that a file exists and is readable.
1052
1053 =head2 ARGUMENTS
1054
1055 The only argument is a file to check readability.
1056
1057 =head2 ERRORS
1058
1059 Any error generated by the underlying uafs_open() call.
1060
1061 =cut
1062
1063 package AFS::Load::Action::access_r;
1064 use strict;
1065 use AFS::Load::Action;
1066 use AFS::ukernel;
1067 our @ISA = ("AFS::Load::Action");
1068
1069 sub new {
1070         my $proto = shift;
1071         my $class = ref($proto) || $proto;
1072         my $self = $class->SUPER::new();
1073
1074         bless($self, $class);
1075
1076         my $args = $#_ + 1;
1077         if ($args != 1) {
1078                 die("wrong number of args ($args) to access_r (should be 1)");
1079         }
1080         $self->{FILE} = $_[0];
1081
1082         return $self;
1083 }
1084
1085 sub doact($) {
1086         my $self = shift;
1087         my $fd = AFS::ukernel::uafs_open($self->{FILE}, POSIX::O_RDONLY, 0644);
1088         if ($fd < 0) {
1089                 return (int($!), '');
1090         }
1091         AFS::ukernel::uafs_close($fd);
1092         return (0,0);
1093 }
1094
1095 sub str($) {
1096         my $self = shift;
1097         return "access_r($self->{FILE})";
1098 }
1099
1100 1;
1101
1102 =head1 fail
1103
1104 =head2 EXAMPLE
1105
1106   step
1107       node 0 fail ENOENT access_r file1
1108
1109 =head2 DESCRIPTION
1110
1111 Verifies that another action fails with a specific error code. This is useful
1112 when an easy way to specify an action is to specify when another action fails,
1113 instead of needing to write a new action.
1114
1115 For example, the above example runs the C<access_r> action on file1, and
1116 succeeds if the C<access_r> action returns with an ENOENT error.
1117
1118 =head2 ARGUMENTS
1119
1120 The first argument is the error code that the subsequent action should fail
1121 with. This can be a number, or an errno symbolic constant. The next argument
1122 is the name of any other action, and the remaining arguments are whatever
1123 arguments should be supplied to that action.
1124
1125 =head2 ERRORS
1126
1127 We only raise an error if the specified action generates a different error than
1128 what was specified, or if no error was raised. In which case, the error that
1129 was generated (if any) is reported.
1130
1131 =cut
1132
1133 package AFS::Load::Action::fail;
1134 use strict;
1135 use AFS::Load::Action;
1136 use AFS::ukernel;
1137 use Errno;
1138 our @ISA = ("AFS::Load::Action");
1139
1140 sub new {
1141         my $proto = shift;
1142         my $class = ref($proto) || $proto;
1143         my $self = $class->SUPER::new();
1144
1145         bless($self, $class);
1146
1147         my $code = shift;
1148         my $args = $#_ + 1;
1149         if ($args < 2) {
1150                 die("wrong number of args ($args) to fail (should be at least 2)");
1151         }
1152
1153         if (!($code =~ m/^\d$/)) {
1154                 my $nCode = eval("if (exists &Errno::$code) { return &Errno::$code; } else { return undef; }");
1155                 if (!defined($nCode)) {
1156                         die("Invalid symbolic error name $code\n");
1157                 }
1158                 $code = $nCode;
1159         }
1160         $self->{ERRCODE} = $code;
1161         $self->{ACT} = AFS::Load::Action->parse(-1, @_);
1162
1163         return $self;
1164 }
1165
1166 sub doact($) {
1167         my $self = shift;
1168         my @ret = $self->{ACT}->doact();
1169
1170         if ($ret[0] == $self->{ERRCODE}) {
1171                 return (0,0);
1172         }
1173
1174         return (-1, "got error: $ret[0] (string: $ret[1]), expected: $self->{ERRCODE}");
1175 }
1176
1177 sub str($) {
1178         my $self = shift;
1179         return "fail(".$self->{ACT}->str().")";
1180 }
1181
1182 1;
1183
1184 =head1 ignore
1185
1186 =head2 EXAMPLE
1187
1188   step
1189       node 0 ignore unlink file1
1190
1191 =head2 DESCRIPTION
1192
1193 Performs another action, ignoring any given errors and always returning
1194 success.
1195
1196 =head2 ARGUMENTS
1197
1198 The first argument is the name of any other action, and the remaining
1199 arguments are whatever arguments should be supplied to that action.
1200
1201 =head2 ERRORS
1202
1203 None.
1204
1205 =cut
1206
1207 package AFS::Load::Action::ignore;
1208 use strict;
1209 use AFS::Load::Action;
1210 use AFS::ukernel;
1211 use Errno;
1212 our @ISA = ("AFS::Load::Action");
1213
1214 sub new {
1215         my $proto = shift;
1216         my $class = ref($proto) || $proto;
1217         my $self = $class->SUPER::new();
1218
1219         bless($self, $class);
1220
1221         my $args = $#_ + 1;
1222         if ($args < 1) {
1223                 die("wrong number of args ($args) to ignore (should be at least 1)");
1224         }
1225
1226         $self->{ACT} = AFS::Load::Action->parse(-1, @_);
1227
1228         return $self;
1229 }
1230
1231 sub doact($) {
1232         my $self = shift;
1233         my @ret = $self->{ACT}->doact();
1234
1235         return (0,0);
1236 }
1237
1238 sub str($) {
1239         my $self = shift;
1240         return "ignore(".$self->{ACT}->str().")";
1241 }
1242
1243 1;
1244
1245 =head1 mkdir
1246
1247 =head2 EXAMPLE
1248
1249   step
1250       node 0 mkdir dir1
1251
1252 =head2 DESCRIPTION
1253
1254 Creates a directory.
1255
1256 =head2 ARGUMENTS
1257
1258 The only argument is the directory to create.
1259
1260 =head2 ERRORS
1261
1262 The same errors as the uafs_mkdir() call.
1263
1264 =cut
1265
1266 package AFS::Load::Action::mkdir;
1267 use strict;
1268 use AFS::Load::Action;
1269 use AFS::ukernel;
1270 our @ISA = ("AFS::Load::Action");
1271
1272 sub new {
1273         my $proto = shift;
1274         my $class = ref($proto) || $proto;
1275         my $self = $class->SUPER::new();
1276
1277         bless($self, $class);
1278
1279         my $args = $#_ + 1;
1280         if ($args != 1) {
1281                 die("wrong number of args ($args) to mkdir (should be 1)");
1282         }
1283         $self->{DIR} = $_[0];
1284
1285         return $self;
1286 }
1287
1288 sub doact($) {
1289         my $self = shift;
1290         my $code = AFS::ukernel::uafs_mkdir($self->{DIR}, 0775);
1291         if ($code) {
1292                 return (int($!), '');
1293         }
1294         return (0,0);
1295 }
1296
1297 sub str($) {
1298         my $self = shift;
1299         return "mkdir($self->{DIR})";
1300 }
1301
1302 1;
1303
1304 =head1 rmdir
1305
1306 =head2 EXAMPLE
1307
1308   step
1309       node 0 rmdir dir1
1310
1311 =head2 DESCRIPTION
1312
1313 Removes a directory.
1314
1315 =head2 ARGUMENTS
1316
1317 The only argument is the directory to remove.
1318
1319 =head2 ERRORS
1320
1321 The same errors as the uafs_rmdir() call.
1322
1323 =cut
1324
1325 package AFS::Load::Action::rmdir;
1326 use strict;
1327 use AFS::Load::Action;
1328 use AFS::ukernel;
1329 our @ISA = ("AFS::Load::Action");
1330
1331 sub new {
1332         my $proto = shift;
1333         my $class = ref($proto) || $proto;
1334         my $self = $class->SUPER::new();
1335
1336         bless($self, $class);
1337
1338         my $args = $#_ + 1;
1339         if ($args != 1) {
1340                 die("wrong number of args ($args) to rmdir (should be 1)");
1341         }
1342         $self->{DIR} = $_[0];
1343
1344         return $self;
1345 }
1346
1347 sub doact($) {
1348         my $self = shift;
1349         my $code = AFS::ukernel::uafs_rmdir($self->{DIR});
1350         if ($code) {
1351                 return (int($!), '');
1352         }
1353         return (0,0);
1354 }
1355
1356 sub str($) {
1357         my $self = shift;
1358         return "rmdir($self->{DIR})";
1359 }
1360
1361 =head1 AUTHORS
1362
1363 Andrew Deason E<lt>adeason@sinenomine.netE<gt>, Sine Nomine Associates.
1364
1365 =head1 COPYRIGHT
1366
1367 Copyright 2010-2011 Sine Nomine Associates.
1368
1369 =cut
1370
1371 1;