lib/Fedora/Rebuild/Package/StateLock.pm

   1 package Fedora::Rebuild::Package::StateLock;
   2 use strict;
   3 use warnings;
   4 use version 0.77; our $VERSION = version->declare("v0.8.0");
   5
   6 use Moose;
   7 use Carp;
   8 use Proc::SyncExec;
   9 use POSIX;
  10 use Data::Dumper;
  11 use Storable qw(nstore_fd retrieve);
  12 use DateTime;
  13 use namespace::clean;
  14
  15
  16 has package => (
  17     is => 'ro',
  18     isa => 'Fedora::Rebuild::Package',
  19     required => 1
  20 );
  21
  22 has state => (
  23     is => 'ro',
  24     isa => 'Str',
  25     required => 1
  26 );
  27
  28 has lockfile => (
  29     is => 'ro',
  30     isa => 'Str',
  31     lazy_build => 1,
  32     init_arg => undef
  33 );
  34
  35 has logfile => (
  36     is => 'ro',
  37     isa => 'Str',
  38     lazy_build => 1,
  39     init_arg => undef
  40 );
  41
  42 has logfd => (
  43     is => 'ro',
  44     isa => 'FileHandle',
  45     lazy_build => 1,
  46     init_arg => undef
  47 );
  48 sub BUILD {
  49     my $self = shift;
  50
  51     if (! defined $self->state || $self->state eq '') {
  52         croak "Invalid `state' attributed passed to StateLock constructor";
  53     }
  54 }
  55
  56 sub _build_lockfile {
  57     my $self = shift;
  58     return $self->package->packagedir . '/.' . $self->state;
  59 }
  60
  61 sub _build_logfile {
  62     my $self = shift;
  63     return $self->lockfile. '.log';
  64 }
  65
  66 sub _build_logfd {
  67     my $self = shift;
  68     my $file = IO::Handle->new();
  69     open ($file, '>', $self->logfile) or
  70         croak "Could not create `" . $self->logfile . "' logfile: $!";
  71     return $file;
  72 }
  73
  74 # Print array into log
  75 sub lograw {
  76     shift->logfd->print(@_);
  77 }
  78
  79 # Print current time and array into log
  80 sub log {
  81     shift->lograw(DateTime->now, ' ', @_);
  82 }
  83
  84 # Return true if state is finshed, otherwise open log file.
  85 sub is_done {
  86     my $self = shift;
  87
  88     if (-e $self->lockfile) {
  89         return 1;
  90     } else {
  91         $self->logfd;
  92         return 0;
  93     }
  94 }
  95
  96 # Remove lock file (if exists) without any other actions.
  97 # Use mark_failed() to close log file too.
  98 # Return value is not specified.
  99 sub remove_lock {
 100     my $self = shift;
 101     if (-e $self->lockfile) { unlink $self->lockfile; }
 102 }
 103
 104 # Fsync and close log file. Croaks on error.
 105 sub close_log {
 106     my $self=shift;
 107     $self->logfd->sync && $self->logfd->close or
 108         croak "Could not sync and close `" . $self->logile . "' logfile: $!";
 109 }
 110
 111 # Create lock file signalling the state has been finished. is_done() return
 112 # true then. Return true if succeeded.
 113 sub mark_done {
 114     my $self = shift;
 115     $self->close_log;
 116     my $file = IO::Handle->new();
 117     open ($file, '>', $self->lockfile) or
 118         croak "Could not open `" . $self->lockfile .
 119             "' lockfile for writing: $!";
 120     $file->sync && close($file) or
 121         croak "Could not sync and close `" . $self->lockfile .
 122             "' lockfile: $!";
 123     return 1;
 124 }
 125
 126 # Close log file. Remove lock file if exist. is_done() return false then.
 127 # Return false.
 128 sub mark_failed {
 129     my $self = shift;
 130     $self->close_log;
 131     $self->remove_lock;
 132     return 0;
 133 }
 134
 135 # Convert ${^CHILD_ERROR_NATIVE} to string description.
 136 # XXX: This is not a method.
 137 sub child_error_as_string {
 138     my $reason = ${^CHILD_ERROR_NATIVE};
 139     if (WIFEXITED($reason)) {
 140         $reason = "exit code " . WEXITSTATUS($reason);
 141     } elsif (WIFSIGNALED($reason)) {
 142         $reason = "signal " . WTERMSIG($reason);
 143     }
 144     return $reason;
 145 }
 146
 147 # Format array of command with argument as quoted string
 148 # XXX: This not a method
 149 sub format_command {
 150     $Data::Dumper::Indent=0;
 151     $Data::Dumper::Terse=1;
 152     return '(' . join(' ', map {Dumper($_)} @_) . ')';
 153 }
 154
 155 # Run command while appending output to log. Blocks. If workdir is nonempty
 156 # string, switch into it befere execution (and opening the log).
 157 # Return true if command succeeds.
 158 sub do {
 159     my ($self, $workdir, @command) = @_;
 160
 161     my $redirect = sub {
 162         open(STDOUT, '>&', $self->logfd->fileno) and
 163         open(STDERR, '>&STDOUT');
 164         $self->log("Executing: " . format_command(@command) . "\n");
 165         if (defined $workdir && $workdir ne '' && !chdir $workdir) {
 166             $self->log("Could not change directory to $workdir: $!\n");
 167             return 0;
 168         }
 169         return 1;
 170     };
 171     my $pid = Proc::SyncExec::sync_exec($redirect, @command);
 172     if (!defined $pid) {
 173         $self->log("Could not execute " . format_command(@command) .  ": $!\n");
 174         return 0;
 175     }
 176     if ($pid != waitpid($pid, 0) || $?) {
 177         $self->log("Command " . format_command(@command) . " failed: " .
 178             child_error_as_string . "\n");
 179         return 0;
 180     }
 181     $self->log("Command " . format_command(@command) .
 182         " returned successfully.\n");
 183     return 1;
 184 }
 185
 186 # Run command while appending stderr and stdout to log and stdout to refered
 187 # output argument. In case of empty command output fill empty string;
 188 # Blocks. If workdir is nonempty string, switch into it befere execution
 189 # (and opening the log).
 190 # Return true if command succeeds.
 191 sub dooutput {
 192     my ($self, $workdir, $output, @command) = @_;
 193
 194     my ($parent, $child);
 195     if (!pipe $child, $parent) {
 196         $self->log("Could not get connected pipes for command " .
 197             format_command(@command) . ": $!\n");
 198         return 0;
 199     }
 200
 201     my $redirect = sub {
 202         close $child and
 203         open(STDOUT, '>&', fileno $parent) and
 204         close $parent and
 205
 206         open(STDERR, '>&', $self->logfd->fileno) and
 207         $self->log("Executing: " . format_command(@command) . "\n");
 208         if (defined $workdir && $workdir ne '' && !chdir $workdir) {
 209             $self->log("Could not change directory to $workdir: $!\n");
 210             return 0;
 211         }
 212         return 1;
 213     };
 214     my $pid = Proc::SyncExec::sync_exec($redirect, @command);
 215     {
 216         my $errno = $!;
 217         close $parent;
 218         $! = $errno;
 219     }
 220     if (!defined $pid) {
 221         $self->log("Could not execute " . format_command(@command) . ": $!\n");
 222         return 0;
 223     }
 224
 225     for ($$output = ''; local $_ = <$child>;) {
 226         $$output .= $_;
 227         $self->lograw($_);
 228     }
 229
 230     if ($pid != waitpid($pid, 0) || $?) {
 231         $self->log("Command " . format_command(@command) . " failed: " .
 232             child_error_as_string . "\n");
 233         return 0;
 234     }
 235
 236     $self->log("Command " . format_command(@command) .
 237         " returned successfully.\n");
 238     return 1;
 239 }
 240
 241 # Serialize referenced variable into file identified by name.
 242 # The file is recreated.
 243 # Return true if command succeeds, otherwise false;
 244 sub nstorereference {
 245     my ($self, $reference, $filename) = @_;
 246
 247     unlink($filename);
 248     my $file = IO::Handle->new();
 249     if (! open($file, '>', $filename)) {
 250         $self->log("Could not open `" . $filename . "' file for writing: $!\n");
 251         return 0;
 252     }
 253     if (! eval { nstore_fd($reference, $file); }) {
 254         $self->log("Could not store variable into `" . $filename .
 255             "' file: $@\n");
 256         close($file);
 257         return 0;
 258     }
 259     if (!$file->sync or !close($file)) {
 260         $self->log("Could not sync and close `" . $filename . "' file: $!\n");
 261         return 0;
 262     }
 263
 264     return 1;
 265 }
 266
 267 # Load serialized variable from file identified by name.
 268 # Return reference to the variable or undef in case of error.
 269 sub retrievereference {
 270     my ($self, $filename) = @_;
 271
 272     my $reference;
 273     if (! eval { $reference = retrieve($filename); } || !$reference) {
 274         $self->log("Could not load variable from `" . $filename .
 275             "' file: $@\n");
 276         return undef;
 277     }
 278
 279     return $reference;
 280 }
 281 1;