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