Archive.pm (3070B)
1 package Bluto::Archive; 2 3 use Cwd; 4 use File::Basename qw/basename fileparse/; 5 use Digest::SHA; 6 7 use Bluto::Log qw/error info debug warn trace/; 8 #use Bluto::Tree qw/ release_path /; 9 use Bluto::Tree; 10 use File::Path qw / make_path /; 11 12 13 sub seal { 14 my $release = shift; 15 my $targz = shift; 16 my $keygrip = shift; 17 # TODO: intended to be numeric flags but now we just use the first bit to force sign or not 18 my $safe = shift; 19 20 if (!defined $keygrip) { 21 if ($safe) { 22 error('have no signing key and safe bit set'); 23 return undef; 24 } 25 } 26 27 my $h = Digest::SHA->new('sha256'); 28 $h->addfile($targz); 29 my $z = $h->hexdigest; 30 debug('calculated sha256 ' . $z . ' for archive ' . $targz); 31 $release->{archive} = $z; 32 my $hp = $targz . '.sha256'; 33 my $f; 34 open($f, ">$hp") or (error('could not open digest file: ' . $!) && return undef); 35 print $f $z . "\t" . basename($targz) . "\n"; 36 close($f); 37 38 if (!defined $keygrip) { 39 warn('skipping archive signature due to missing key'); 40 return $z; 41 } 42 43 my @cmd = ('gpg', '-a', '-b', '-u', $keygrip, $hp); 44 system(@cmd); 45 if ($?) { 46 error('failed sign with key '. $keygrip); 47 unlink($hp); 48 return undef; 49 } 50 51 return $z; 52 } 53 54 sub create { 55 my $release = shift; 56 my $env = shift; 57 my $flags = shift; 58 59 my $keygrip = $release->{_author_maintainer}->[2]; 60 debug('using keygrip for archive: ' . $keygrip); 61 62 my $old_dir = cwd; 63 64 chdir($env->{content_dir}); 65 66 my $targz_local = undef; 67 my $targz_stem = $release->{slug} . '-' . $release->{version}; 68 69 my $rev_version = $release->{tag_prefix} . $release->{version}; 70 my $rev = `git rev-parse $rev_version --abbrev-ref`; 71 if (!defined $rev) { 72 error('unable to determine revision'); 73 chdir($old_dir); 74 return undef; 75 } 76 chomp($rev); 77 my $targz = $targz_stem . '+build.' . $rev . '.tar.gz'; 78 my $targz_base = File::Spec->catfile(Bluto::Tree->release_path()); 79 make_path($targz_base); 80 $targz_local = File::Spec->catfile($targz_base, $targz); 81 82 if (! -f $targz_local ) { 83 debug("no package file found, looked for: " . $targz_local); 84 my @cmd = ('git', 'archive', $release->{tag_prefix} . $release->{version}, '--format', 'tar.gz', '-o', $targz_local); 85 system(@cmd); 86 if ($?) { 87 error("package file generation fail: " . $e); 88 unlink($targz); 89 chdir($old_dir); 90 return undef; 91 } 92 93 # my $cmd = Git::Repository::Command(['git', 'archive', '--format=tar.gz', '-o', $targz]); 94 # my $e = $cmd->stderr(); 95 # $cmd->close(); 96 # if ($cmd->exit()) { 97 # error("package file generation fail: " . $e); 98 # } 99 100 if (! -f $targz_local ) { 101 error("package generation reported ok but still no file"); 102 chdir($old_dir); 103 return undef; 104 } 105 106 my $seal = seal($release, $targz_local, $keygrip, $flags & 1); 107 if (!defined $seal) { 108 error("failed sealing archive"); 109 unlink($targz_local); 110 chdir($old_dir); 111 return undef; 112 } 113 info('sealed archive as sha256 ' . $seal . ' signed by ' . $keygrip); 114 } else { 115 info("using existing package file: " . $targz_local); 116 warn("existing package file is not being checked in any way 8|"); 117 } 118 119 chdir($old_dir); 120 121 return $targz_local; 122 } 123 124 1;