use Dpkg::Version;
use POSIX;
use IPC::Open2;
+use Digest::SHA;
our $our_version = 'UNRELEASED'; ###substituted###
our (@git) = qw(git);
our (@dget) = qw(dget);
+our (@curl) = qw(curl -f);
our (@dput) = qw(dput);
our (@debsign) = qw(debsign);
our (@gpg) = qw(gpg);
our (@mergechanges) = qw(mergechanges -f);
our (@changesopts) = ('');
-our %opts_opt_map = ('dget' => \@dget,
+our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
+ 'curl' => \@curl,
'dput' => \@dput,
'debsign' => \@debsign,
'gpg' => \@gpg,
my $r = $ua->get(@_) or die $!;
return undef if $r->code == 404;
$r->is_success or fail "failed to fetch $what: ".$r->status_line;
- return $r->decoded_content();
+ return $r->decoded_content(charset => 'none');
}
-our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
+our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
sub shellquote {
my @out;
'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
'dgit-distro.debian.git-check' => 'ssh-cmd',
'dgit-distro.debian.git-create' => 'ssh-cmd',
- 'dgit-distro.debian.sshpsql-host' => 'coccia.debian.org',
+ 'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org',
'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
+ 'dgit-distro.ubuntu.git-check' => 'false',
+ 'dgit-distro.ubuntu.mirror' => 'http://archive.ubuntu.com/ubuntu',
'dgit-distro.test-dummy.ssh' => "$td/ssh",
'dgit-distro.test-dummy.username' => "alice",
'dgit-distro.test-dummy.git-check' => "ssh-cmd",
my ($proto,$data) = @_;
sql_injection_check $isuite, $package;
my @rows = sshpsql($data, <<END);
- SELECT source.version, component.name, files.filename
+ SELECT source.version, component.name, files.filename, files.sha256sum
FROM source
JOIN src_associations ON source.id = src_associations.source
JOIN suite ON suite.id = src_associations.suite
AND files.filename LIKE '%.dsc';
END
@rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+ my $digester = Digest::SHA->new(256);
@rows = map {
- my ($vsn,$component,$filename) = @$_;
- [ $vsn, "/pool/$component/$filename" ];
+ my ($vsn,$component,$filename,$sha256sum) = @$_;
+ [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
} @rows;
return @rows;
}
canonicalise_suite();
my @vsns = archive_query('archive_query');
foreach my $vinfo (@vsns) {
- my ($vsn,$subpath) = @$vinfo;
+ my ($vsn,$subpath,$digester,$digest) = @$vinfo;
$dscurl = access_cfg('mirror').$subpath;
$dscdata = url_get($dscurl);
if (!$dscdata) {
$skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
next;
}
+ if ($digester) {
+ $digester->reset();
+ $digester->add($dscdata);
+ my $got = $digester->hexdigest();
+ $got eq $digest or
+ fail "$dscurl has hash $got but".
+ " archive told us to expect $digest";
+ }
my $dscfh = new IO::File \$dscdata, '<' or die $!;
printdebug Dumper($dscdata) if $debug>1;
$dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
printdebug Dumper($dsc) if $debug>1;
my $fmt = getfield $dsc, 'Format';
fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+ $dsc_checked = !!$digester;
return;
}
$dsc = undef;
return $r+0;
} elsif ($how eq 'true') {
return 1;
+ } elsif ($how eq 'false') {
+ return 0;
} else {
badcfg "unknown git-check \`$how'";
}
sub generate_commit_from_dsc () {
prep_ud();
changedir $ud;
- my @files;
- foreach my $f (dsc_files()) {
+
+ foreach my $fi (dsc_files_info()) {
+ my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- push @files, $f;
+
link "../../../$f", $f
or $!==&ENOENT
or die "$f $!";
+
+ complete_file_from_dsc('.', $fi);
+
+ if (is_orig_file($f)) {
+ link $f, "../../../../$f"
+ or $!==&EEXIST
+ or die "$f $!";
+ }
}
- runcmd @dget, qw(--), $dscurl;
- foreach my $f (grep { is_orig_file($_) } @files) {
- link $f, "../../../../$f"
- or $!==&EEXIST
- or die "$f $!";
- }
+
+ my $dscfn = "$package.dsc";
+
+ open D, ">", $dscfn or die "$dscfn: $!";
+ print D $dscdata or die "$dscfn: $!";
+ close D or die "$dscfn: $!";
+ my @cmd = qw(dpkg-source);
+ push @cmd, '--no-check' if $dsc_checked;
+ push @cmd, qw(-x --), $dscfn;
+ runcmd @cmd;
+
my ($tree,$dir) = mktree_in_ud_from_only_subdir();
runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
return $outputhash;
}
+sub complete_file_from_dsc ($$) {
+ our ($dstdir, $fi) = @_;
+ # Ensures that we have, in $dir, the file $fi, with the correct
+ # contents. (Downloading it from alongside $dscurl if necessary.)
+
+ my $f = $fi->{Filename};
+ my $tf = "$dstdir/$f";
+ my $downloaded = 0;
+
+ if (stat $tf) {
+ progress "using existing $f";
+ } else {
+ die "$tf $!" unless $!==&ENOENT;
+
+ my $furl = $dscurl;
+ $furl =~ s{/[^/]+$}{};
+ $furl .= "/$f";
+ die "$f ?" unless $f =~ m/^${package}_/;
+ die "$f ?" if $f =~ m#/#;
+ runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+ next if !act_local();
+ $downloaded = 1;
+ }
+
+ open F, "<", "$tf" or die "$tf: $!";
+ $fi->{Digester}->reset();
+ $fi->{Digester}->addfile(*F);
+ F->error and die $!;
+ my $got = $fi->{Digester}->hexdigest();
+ $got eq $fi->{Hash} or
+ fail "file $f has hash $got but .dsc".
+ " demands hash $fi->{Hash} ".
+ ($downloaded ? "(got wrong file from archive!)"
+ : "(perhaps you should delete this file?)");
+}
+
sub ensure_we_have_orig () {
foreach my $fi (dsc_files_info()) {
my $f = $fi->{Filename};
next unless is_orig_file($f);
- if (open F, "<", "../$f") {
- $fi->{Digester}->reset();
- $fi->{Digester}->addfile(*F);
- F->error and die $!;
- my $got = $fi->{Digester}->hexdigest();
- $got eq $fi->{Hash} or
- fail "existing file $f has hash $got but .dsc".
- " demands hash $fi->{Hash}".
- " (perhaps you should delete this file?)";
- progress "using existing $f";
- next;
- } else {
- die "$f $!" unless $!==&ENOENT;
- }
- my $origurl = $dscurl;
- $origurl =~ s{/[^/]+$}{};
- $origurl .= "/$f";
- die "$f ?" unless $f =~ m/^${package}_/;
- die "$f ?" if $f =~ m#/#;
- runcmd_ordryrun_local shell_cmd 'cd ..', @dget,'--',$origurl;
+ complete_file_from_dsc('..', $fi);
}
}
printdebug "actually entering push\n";
prep_ud();
+ access_giturl(); # check that success is vaguely likely
+
my $clogpfn = ".git/dgit/changelog.822.tmp";
runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
}
$dstdir ||= "$package";
+ if (stat $dstdir) {
+ fail "$dstdir already exists";
+ } elsif ($! != &ENOENT) {
+ die "$dstdir: $!";
+ }
+
my $cwd_remove;
if ($rmonerror && !$dryrun_level) {
$cwd_remove= getcwd();
}
}
+sub cmd_clean () {
+ badusage "clean takes no additional arguments" if @ARGV;
+ clean_tree();
+}
+
sub build_prep () {
badusage "-p is not allowed when building" if defined $package;
check_not_dirty();
quilt_fixup_editor();
}
-delete $ENV{'DGET_UNPACK'};
-
parseopts();
print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
}
my $cmd = shift @ARGV;
$cmd =~ y/-/_/;
-{ no strict qw(refs); &{"cmd_$cmd"}(); }
+
+my $fn = ${*::}{"cmd_$cmd"};
+$fn or badusage "unknown operation $cmd";
+$fn->();
~ianmdlvl / dgit.git / blobdiff