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.12.1");
   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 use IO::Handle;
  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->logfile . "' logfile: $!";
 109 }
 110
 111 # Remove log file (if exists) without any other actions.
 112 # Return value is not specified.
 113 sub remove_log {
 114     my $self = shift;
 115     if (-e $self->logfile) { unlink $self->logfile; }
 116 }
 117
 118 # Create lock file signalling the state has been finished. is_done() return
 119 # true then. Return true if succeeded.
 120 sub mark_done {
 121     my $self = shift;
 122     $self->close_log;
 123     my $file = IO::Handle->new();
 124     open ($file, '>', $self->lockfile) or
 125         croak "Could not open `" . $self->lockfile .
 126             "' lockfile for writing: $!";
 127     $file->sync && close($file) or
 128         croak "Could not sync and close `" . $self->lockfile .
 129             "' lockfile: $!";
 130     return 1;
 131 }
 132
 133 # Close log file. Remove lock file if exist. is_done() return false then.
 134 # Return false.
 135 sub mark_failed {
 136     my $self = shift;
 137     $self->close_log;
 138     $self->remove_lock;
 139     return 0;
 140 }
 141
 142 # Convert ${^CHILD_ERROR_NATIVE} to string description.
 143 # XXX: This is not a method.
 144 sub child_error_as_string {
 145     my $reason = ${^CHILD_ERROR_NATIVE};
 146     if (WIFEXITED($reason)) {
 147         $reason = "exit code " . WEXITSTATUS($reason);
 148     } elsif (WIFSIGNALED($reason)) {
 149         $reason = "signal " . WTERMSIG($reason);
 150     }
 151     return $reason;
 152 }
 153
 154 # Format array of command with argument as quoted string
 155 # XXX: This not a method
 156 sub format_command {
 157     $Data::Dumper::Indent=0;
 158     $Data::Dumper::Terse=1;
 159     return '(' . join(' ', map {Dumper($_)} @_) . ')';
 160 }
 161
 162 # Run command while appending output to log. Blocks. If workdir is nonempty
 163 # string, switch into it befere execution (and opening the log).
 164 # Return true if command succeeds.
 165 sub do {
 166     my ($self, $workdir, @command) = @_;
 167
 168     my $redirect = sub {
 169         open(STDOUT, '>&', $self->logfd->fileno) and
 170         open(STDERR, '>&STDOUT');
 171         $self->log("Executing: " . format_command(@command) . "\n");
 172         if (defined $workdir && $workdir ne '' && !chdir $workdir) {
 173             $self->log("Could not change directory to $workdir: $!\n");
 174             return 0;
 175         }
 176         return 1;
 177     };
 178     my $pid = Proc::SyncExec::sync_exec($redirect, @command);
 179     if (!defined $pid) {
 180         $self->log("Could not execute " . format_command(@command) .  ": $!\n");
 181         return 0;
 182     }
 183     if ($pid != waitpid($pid, 0) || $?) {
 184         $self->log("Command " . format_command(@command) . " failed: " .
 185             child_error_as_string . "\n");
 186         return 0;
 187     }
 188     $self->log("Command " . format_command(@command) .
 189         " returned successfully.\n");
 190     return 1;
 191 }
 192
 193 # Run command while appending stderr and stdout to log and stdout to refered
 194 # output argument. In case of empty command output fill empty string;
 195 # Blocks. If workdir is nonempty string, switch into it befere execution
 196 # (and opening the log).
 197 # Return true if command succeeds.
 198 sub dooutput {
 199     my ($self, $workdir, $output, @command) = @_;
 200
 201     my ($parent, $child);
 202     if (!pipe $child, $parent) {
 203         $self->log("Could not get connected pipes for command " .
 204             format_command(@command) . ": $!\n");
 205         return 0;
 206     }
 207
 208     my $redirect = sub {
 209         close $child and
 210         open(STDOUT, '>&', fileno $parent) and
 211         close $parent and
 212
 213         open(STDERR, '>&', $self->logfd->fileno) and
 214         $self->log("Executing: " . format_command(@command) . "\n");
 215         if (defined $workdir && $workdir ne '' && !chdir $workdir) {
 216             $self->log("Could not change directory to $workdir: $!\n");
 217             return 0;
 218         }
 219         return 1;
 220     };
 221     my $pid = Proc::SyncExec::sync_exec($redirect, @command);
 222     {
 223         my $errno = $!;
 224         close $parent;
 225         $! = $errno;
 226     }
 227     if (!defined $pid) {
 228         $self->log("Could not execute " . format_command(@command) . ": $!\n");
 229         return 0;
 230     }
 231
 232     for ($$output = ''; local $_ = <$child>;) {
 233         $$output .= $_;
 234         $self->lograw($_);
 235     }
 236
 237     if ($pid != waitpid($pid, 0) || $?) {
 238         $self->log("Command " . format_command(@command) . " failed: " .
 239             child_error_as_string . "\n");
 240         return 0;
 241     }
 242
 243     $self->log("Command " . format_command(@command) .
 244         " returned successfully.\n");
 245     return 1;
 246 }
 247
 248 # Serialize referenced variable into file identified by name.
 249 # The file is recreated.
 250 # Return true if command succeeds, otherwise false;
 251 sub nstorereference {
 252     my ($self, $reference, $filename) = @_;
 253
 254     unlink($filename);
 255     my $file = IO::Handle->new();
 256     if (! open($file, '>', $filename)) {
 257         $self->log("Could not open `" . $filename . "' file for writing: $!\n");
 258         return 0;
 259     }
 260     if (! eval { nstore_fd($reference, $file); }) {
 261         $self->log("Could not store variable into `" . $filename .
 262             "' file: $@\n");
 263         close($file);
 264         return 0;
 265     }
 266     if (!$file->sync or !close($file)) {
 267         $self->log("Could not sync and close `" . $filename . "' file: $!\n");
 268         return 0;
 269     }
 270
 271     return 1;
 272 }
 273
 274 # Load serialized variable from file identified by name.
 275 # Return reference to the variable or undef in case of error.
 276 sub retrievereference {
 277     my ($self, $filename) = @_;
 278
 279     my $reference;
 280     if (! eval { $reference = retrieve($filename); } || !$reference) {
 281         $self->log("Could not load variable from `" . $filename .
 282             "' file: $@\n");
 283         return undef;
 284     }
 285
 286     return $reference;
 287 }
 288 1;