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