X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=d57b64351e1883f78772e9ae075be814f0bee8c4;hb=7593c9b857a3d4517d8772ff0e31faf5cc3b4fb4;hp=978eabe84494bb1c01b02689da9fe2ce2345aa53;hpb=a778f6fe55a7672a9b0052c7b946c5fca5b7c61c;p=dgit.git diff --git a/dgit b/dgit index 978eabe8..d57b6435 100755 --- a/dgit +++ b/dgit @@ -30,7 +30,7 @@ setup_sigwarn(); use IO::Handle; use Data::Dumper; -use LWP::UserAgent; +use WWW::Curl::Easy; use Dpkg::Control::Hash; use File::Path; use File::Spec; @@ -639,20 +639,6 @@ sub progress { our $ua; -sub url_get { - if (!$ua) { - $ua = LWP::UserAgent->new(); - $ua->env_proxy; - } - my $what = $_[$#_]; - progress "downloading $what..."; - my $r = $ua->get(@_) or confess "$!"; - return undef if $r->code == 404; - $r->is_success or fail f_ "failed to fetch %s: %s", - $what, $r->status_line; - return $r->decoded_content(charset => 'none'); -} - our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); sub act_local () { return $dryrun_level <= 1; } @@ -1198,8 +1184,6 @@ sub url_fetch ($;@) { # AccessBase => 'archive-query' (eg) # CurlOpts => { key => value } - use WWW::Curl::Easy; - my $curl = WWW::Curl::Easy->new; my $setopt = sub { my ($k,$v) = @_; @@ -1207,7 +1191,7 @@ sub url_fetch ($;@) { confess "$k $v ".$curl->strerror($x)." ?" if $x; }; - my $response_body; + my $response_body = ''; $setopt->(CURLOPT_REDIR_PROTOCOLS, CURLPROTO_HTTPS|CURLPROTO_HTTP); $setopt->(CURLOPT_URL, $url); $setopt->(CURLOPT_NOSIGNAL, 1); @@ -1239,6 +1223,8 @@ sub url_fetch ($;@) { fail f_ "fetch of %s gave HTTP code %s", $url, $code unless $url =~ m#^file://# or $code =~ m/^2/; + + confess unless defined $response_body; return $response_body; } @@ -1750,7 +1736,7 @@ sub get_archive_dsc () { foreach my $vinfo (@vsns) { my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo; $dscurl = $vsn_dscurl; - $dscdata = url_get($dscurl); + $dscdata = url_fetch($dscurl); if (!$dscdata) { $skew_warning_vsn = $vsn if !defined $skew_warning_vsn; next; @@ -1808,7 +1794,9 @@ sub check_for_git () { CurlOpts => { CURLOPT_NOBODY() => 1 }, Ok404 => 1, AccessBase => 'git-check'; - return defined $result; + $result = defined $result; + printdebug "dgit-repos check_for_git => $result.\n"; + return $result; } elsif ($how eq 'true') { return 1; } elsif ($how eq 'false') { @@ -3860,6 +3848,15 @@ END printdone f_ "ready for work in %s", $dstdir; } +sub vcs_git_url_of_ctrl ($) { + my ($ctrl) = @_; + my $vcsgiturl = $ctrl->{'Vcs-Git'}; + if (length $vcsgiturl) { + $vcsgiturl =~ s/\s+-b\s+\S+//g; + } + return $vcsgiturl; +} + sub clone ($) { # in multisuite, returns twice! # once in parent after first suite fetched, @@ -3898,9 +3895,8 @@ sub clone ($) { progress __ "starting new git history"; } fetch_from_archive() or no_such_package; - my $vcsgiturl = $dsc->{'Vcs-Git'}; + my $vcsgiturl = vcs_git_url_of_ctrl $dsc; if (length $vcsgiturl) { - $vcsgiturl =~ s/\s+-b\s+\S+//g; runcmd @git, qw(remote add vcs-git), $vcsgiturl; } clone_finish($dstdir); @@ -4036,6 +4032,7 @@ sub get_source_format () { } $_ = ; F->error and confess "$!"; + close F; chomp; return ($_, \%options); } @@ -4988,7 +4985,7 @@ sub cmd_update_vcs_git () { print STDERR f_ "changing vcs-git url to: %s\n", $url; @cmd = (@git, qw(remote set-url vcs-git), $url); } - runcmd_ordryrun_local @cmd; + runcmd_ordryrun_local @cmd if @cmd; if ($dofetch) { print f_ "fetching (%s)\n", "@ARGV"; runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;