Yaml.pm (2181B)
1 package Bluto::Yaml; 2 3 use File::Basename qw/basename/; 4 use Bluto::Log qw/error info debug warn trace/; 5 use Bluto::Tree; 6 7 8 sub yaml_path { 9 my $release = shift; 10 11 my $fp_base = File::Spec->catfile(Bluto::Tree->announce_path); 12 if ( ! -d $fp_base) { 13 make_path($fp_base); 14 } 15 my $fp = File::Spec->catfile($fp_base, $release->{slug} . '.bluto.yaml'); 16 return $fp; 17 } 18 19 sub add_existing_releases { 20 my $release = shift; 21 my $yr = shift; 22 23 my $fp = yaml_path($release); 24 25 if ( ! -f $fp ) { 26 debug("no existing release yaml"); 27 return $yr; 28 } 29 my $yf = YAML::Tiny->read($fp); 30 for my $k (keys %{$yf->[0]->{releases}}) { 31 if (!defined $k) { 32 continue; 33 } 34 debug("processing file " . $fp); 35 debug("processing key " . $k); 36 if (defined $yr->{releases}->{$k}) { 37 error("already have version in yaml: " . $k); 38 return $yr; 39 } 40 debug("adding existing release to yaml: " . $k); 41 $yr->{releases}->{$k} = $yf->[0]->{releases}->{$k}; 42 } 43 44 return $yr; 45 } 46 47 sub add_release_yaml { 48 my $release = shift; 49 my $yb = shift; 50 my $yr = shift; 51 my $env = shift; 52 53 if (!defined $yb->{releases}) { 54 $yb->{releases} = {}; 55 } 56 57 $yr->{timestamp} = $release->{timeobj}->epoch; 58 $yr->{archive} = 'sha256:' . $release->{archive}; 59 $yb->{releases}->{$env->{version}} = $yr; 60 61 $yb = add_existing_releases($release, $yb); 62 63 return YAML::Tiny->new($yb); 64 } 65 66 sub to_file { 67 my $release = shift; 68 my $y = shift; 69 my $keygrip = shift; 70 71 my $fp = yaml_path($release); 72 73 $y->write($fp); 74 75 # DRY with Bluto/Archive.pm 76 my $keygrip = $release->{_author_maintainer}->[2]; 77 debug('using keygrip for yaml: ' . $keygrip); 78 79 my $h = Digest::SHA->new('sha256'); 80 $h->addfile($fp); 81 my $z = $h->hexdigest; 82 debug('calculated sha256 ' . $z . ' for yaml ' . $fp); 83 84 my $hp = $fp . '.sha256'; 85 my $f; 86 open($f, ">$hp") or (error('could not open yaml digest file: ' . $!) && return undef); 87 print $f $z . "\t" . basename($fp) . "\n"; 88 close($f); 89 90 if (!defined $keygrip) { 91 warn('skipping yaml signature due to missing key'); 92 return $fp; 93 } 94 95 my @cmd = ('gpg', '-a', '-b', '-u', $keygrip, $hp); 96 system(@cmd); 97 if ($?) { 98 error('failed sign with key '. $keygrip); 99 unlink($hp); 100 return undef; 101 } 102 return $fp; 103 } 104 105 1;