Re: [PATCH] proposed v3 source format using .git.tar.gz
On Fri, Oct 05, 2007 at 07:16:13PM -0400, Joey Hess wrote:
> I have a sourcev3 branch with my changes at <git://kitenet.net/dpkg>,
> and have also attached a diff to this mail. I feel that this is ready
> for review and hopefully merging into dpkg now. Looking forward to your
> comments.
A little code review follows.
> +# You should have received a copy of the GNU General Public License
> +# along with this program; if not, write to the Free Software
> +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
old FSF address (not really important, but while we're at it ;)
> +sub sanity_check {
> + my $srcdir=shift;
> +
> + if (! -s "$srcdir/.git") {
> + main::error(sprintf(_g("%s is not the top directory of a git repository (%s/.git not present), but Format git was specified"), $srcdir, $srcdir));
you probably mean -e or -d here? -s on a directory is kinda strange.
printing $srcdir twice might bloat the error message.
> + }
> + if (-s "$srcdir/.gitmodules") {
> + main::error(sprintf(_g("git repository %s uses submodules. This is not yet supported."), $srcdir));
> + }
> +
> + # Symlinks from .git to outside could cause unpack failures, or
> + # point to files they shouldn't, so check for and don't allow.
> + if (-l "$srcdir/.git") {
> + main::error(sprintf(_g("%s is a symlink"), "$srcdir/.git"));
> + }
> + my $abs_srcdir=Cwd::abs_path($srcdir);
> + find(sub {
> + if (-l $_) {
> + if (Cwd::abs_path(readlink($_)) !~ /^\Q$abs_srcdir\E(\/|$)/) {
> + main::error(sprintf(_g("%s is a symlink to outside %s"), $File::Find::name, $srcdir));
> + }
> + }
> + }, "$srcdir/.git");
Maybe it would be easier to just disallow symlinks completly? Or are
there important use cases for that?
> +}
> +
> +# Called before a tarball is created, to prepare the tar directory.
> +sub prep_tar {
> + my $srcdir=shift;
> + my $tardir=shift;
> +
> + sanity_check($srcdir);
> +
> + if (! -e "$srcdir/.git") {
> + main::error(sprintf(_g("%s is not a git repository, but Format git was specified"), $srcdir));
> + }
> + if (-e "$srcdir/.gitmodules") {
> + main::error(sprintf(_g("git repository %s uses submodules. This is not yet supported."), $srcdir));
> + }
Duplicated code from sanity_check
> +
> + # Check for uncommitted files.
> + open(GIT_STATUS, "LANG=C cd $srcdir && git-status |") ||
> + main::subprocerr("cd $srcdir && git-status");
you make a lot "cd $srcdir". Maybe you should just chdir() in the parent
process? This would also take care of funny things in $srcdir like
whitespaces...
> + my $clean=0;
> + my $status="";
> + while (<GIT_STATUS>) {
> + if (/^\Qnothing to commit (working directory clean)\E$/) {
> + $clean=1;
> + }
> + else {
> + $status.="git-status: $_";
> + }
> + }
> + close GIT_STATUS;
> + # git-status exits 1 if there are uncommitted changes or if
> + # the repo is clean, and 0 if there are uncommitted changes
> + # listed in the index.
> + if ($? && $? >> 8 != 1) {
> + main::subprocerr("cd $srcdir && git status");
> + }
> + if (! $clean) {
> + # To support dpkg-buildpackage -i, get a list of files
dpkg-source -i would be the proper attribution here. dpkg-buildpackage
implements -i only as a pass-through option.
> + # eqivilant to the ones git-status finds, and remove any
is that an English word?
> + # ignored files from it.
> + my @ignores="--exclude-per-directory=.gitignore";
> + my $core_excludesfile=`cd $srcdir && git-config --get core.excludesfile`;
> + chomp $core_excludesfile;
> + if (length $core_excludesfile && -e "$srcdir/$core_excludesfile") {
> + push @ignores, "--exclude-from='$core_excludesfile'";
> + }
> + if (-e "$srcdir/.git/info/exclude") {
> + push @ignores, "--exclude-from=.git/info/exclude";
> + }
> + open(GIT_LS_FILES, "cd $srcdir && git-ls-files -m -d -o @ignores |") ||
> + main::subprocerr("cd $srcdir && git-ls-files");
If you get rid of the cd you could use the '-|', @array form of open
here which would be preferable imho.
This is essentially running git-status again without the output
beautification... Can't we avoid doing the work twice?
Also I would prefer using long options where available. It's not like
anyone has to type them more than once ;)
> + my @files;
> + while (<GIT_LS_FILES>) {
> + chomp;
> + if (! length $main::diff_ignore_regexp ||
> + ! m/$main::diff_ignore_regexp/o) {
> + push @files, $_;
> + }
> + }
> + close(GIT_LS_FILES) || main::syserr("git-ls-files exited nonzero");
> +
> + if (@files) {
> + print $status;
> + main::error(sprintf(_g("uncommitted, not-ignored changes in working directory: %s"),
> + join(" ", @files)));
That intendation looks wrong.
> + }
> + }
> +
> + # garbage collect the repo
> + system("cd $srcdir && git-gc --prune");
> + $? && main::subprocerr("cd $srcdir && git-gc --prune");
Again, dropping the cd would make it possible to use the @array form.
git gc --prune is also a very rude thing to do implicitly. Maybe this
should better be done in the copy? We could be even more rude then and
also delete the reflog which would make git gc way more efficient in
some cases.
> + # TODO support for creating a shallow clone for those cases where
> + # uploading the whole repo history is not desired
> +
> + mkdir($tardir,0755) ||
> + &syserr(sprintf(_g("unable to create `%s'"), $tardir));
> + system("cp -a $srcdir/.git $tardir");
> + $? && main::subprocerr("cp -a $srcdir/.git $tardir");
you actually can use the @array form here.
> +
> + # As an optimisation, remove the index. It will be recreated by git
> + # reset during unpack. It's probably small, but you never know, this
> + # might save a lot of space.
> + unlink("$tardir/.git/index"); # error intentionally ignored
> +}
> +
> +# Called after a tarball is unpacked, to check out the working copy.
> +sub post_unpack_tar {
> + my $srcdir=shift;
> +
> + sanity_check($srcdir);
> +
> + # Disable git hooks, as unpacking a source package should not
> + # involve running code.
> + foreach my $hook (glob("$srcdir/.git/hooks/*")) {
> + if (-x $hook) {
> + main::warning(sprintf(_g("executable bit set on %s; clearing"), $hook));
> + chmod(0644 &~ umask(), $hook) ||
> + main::syserr(sprintf(_g("unable to change permission of `%s'"), $hook));
why these very cautios permissions here (i.e. why not 0666)?
> + }
> + }
> +
> + # This is a paranoia measure, since the index is not normally
> + # provided by possibly-untrusted third parties, remove it if
> + # present (git-rebase will recreate it).
> + if (-e "$srcdir/.git/index" || -l "$srcdir/.git/index") {
> + unlink("$srcdir/.git/index") ||
> + main::syserr(sprintf(_g("unable to remove `%s'"), "$srcdir/.git/index"));
> + }
> +
> + # Comment out potentially probamatic or annoying stuff in
> + # .git/config.
> + my $safe_fields=qr/^(
> + core\.autocrlf |
> + branch\..* |
> + remote\..* |
> + core\.repositoryformatversion |
> + core\.filemode |
> + core\.logallrefupdates |
> + core\.bare
> + )$/x;
> + # This needs to be an absolute path, for some reason.
> + my $configfile=Cwd::abs_path("$srcdir/.git/config");
> + open(GIT_CONFIG, "git-config --file $configfile -l |") ||
> + main::subprocerr("git-config");
you can use the @array form here. And using git-config --null
would preferable here. This was introduced only recently, but since
git-config isn't available in etch's version at all...
> + my @config=<GIT_CONFIG>;
> + close(GIT_CONFIG) || main::syserr("git-config exited nonzero");
> + my %removed_fields;
> + foreach (@config) {
> + chomp;
> + my ($field, $value)=split(/=/, $_, 2);
> + if ($field !~ /$safe_fields/) {
> + if (! exists $removed_fields{$field}) {
> + system("git-config", "--file", $configfile,
> + "--unset-all", $field);
> + $? && main::subprocerr("git-config --file $configfile --unset-all $field");
> + }
> + push @{$removed_fields{$field}}, $value;
Have you tested what happens if you try to unset something that
git-config -l listed but that is really from the global or the system
config file?
> + }
> + }
> + if (%removed_fields) {
> + open(GIT_CONFIG, ">>", $configfile) ||
> + main::syserr(sprintf(_g("unstable to append to %s", $configfile)));
> + print GIT_CONFIG "\n# "._g("The following setting(s) were disabled by dpkg-source").":\n";
> + foreach my $field (sort keys %removed_fields) {
> + foreach my $value (@{$removed_fields{$field}}) {
> + print GIT_CONFIG "# $field=$value\n";
> + }
> + }
> + close GIT_CONFIG;
> + main::warning(_g(_g("modifying .git/config to comment out some settings")));
> + }
nested _g
> +
> + # Note that git-reset is used to repopulate the WC with files.
> + # git-clone isn't used because the repo might be an unclonable
> + # shallow copy. git-reset also recreates the index.
> + # XXX git-reset should be made to run in quiet mode here, but
> + # lacks a good way to do it. Bug filed.
> + system("cd $srcdir && git-reset --hard");
again a chdir + system(@array) would be better imho.
Why not git checkout -f ?
> + $? && main::subprocerr("cd $srcdir && git-reset --hard");
> +}
> +
> +1
> diff --git a/scripts/Makefile.am b/scripts/Makefile.am
> index 87ea060..8238bbc 100644
> --- a/scripts/Makefile.am
> +++ b/scripts/Makefile.am
> @@ -55,6 +55,7 @@ CLEANFILES = \
>
> perllibdir = $(PERL_LIBDIR)
> nobase_dist_perllib_DATA = \
> + Dpkg/Source/VCS/git.pm \
> Dpkg/BuildOptions.pm \
> Dpkg/Gettext.pm \
> Dpkg.pm
> diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
> index 5b7802d..6c823c8 100755
> --- a/scripts/dpkg-source.pl
> +++ b/scripts/dpkg-source.pl
> @@ -17,7 +17,7 @@ my $controlfile;
> my $changelogfile;
> my $changelogformat;
>
> -my $diff_ignore_regexp = '';
> +our $diff_ignore_regexp = '';
> my $diff_ignore_default_regexp = '
> # Ignore general backup files
> (?:^|/).*~$|
> @@ -71,7 +71,7 @@ $diff_ignore_default_regexp =~ s/\n//sg;
>
> my $sourcestyle = 'X';
> my $min_dscformat = 1;
> -my $max_dscformat = 2;
> +my $max_dscformat = 3;
> my $def_dscformat = "1.0"; # default format for -b
>
> my $expectprefix;
> @@ -190,6 +190,13 @@ sub handleformat {
> return $1 >= $min_dscformat && $1 <= $max_dscformat;
> }
>
> +sub loadvcs {
> + my $vcs = shift;
> + my $mod = "Dpkg::Source::VCS::$vcs";
> + eval qq{use $mod};
> + return ! $@;
> +}
Since we never ever want to import something from $mod, maybe we should
require it?
> my $opmode;
> my $tar_ignore_default_pattern_done;
> @@ -252,10 +259,6 @@ $SIG{'PIPE'} = 'DEFAULT';
>
> if ($opmode eq 'build') {
>
> - $sourcestyle =~ y/X/A/;
> - $sourcestyle =~ m/[akpursnAKPUR]/ ||
> - &usageerr(sprintf(_g("source handling style -s%s not allowed with -b"), $sourcestyle));
> -
> @ARGV || &usageerr(_g("-b needs a directory"));
> @ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument"));
> my $dir = shift(@ARGV);
> @@ -283,7 +286,7 @@ if ($opmode eq 'build') {
> if (s/^C //) {
> if (m/^Source$/i) {
> setsourcepackage($v);
> - } elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
> + } elsif (m/^(Format|Standards-Version|Origin|Maintainer|Homepage)$/i ||
> m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
> $f{$_}= $v;
> }
> @@ -351,6 +354,39 @@ if ($opmode eq 'build') {
> &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v));
> }
> }
> +
> + my $vcs;
> + if ($f{Format} =~ /^\s*(\d+\.\d+)\s*$/) {
> + if ($1 >= 3.0) {
> + error(sprintf(_g("don't know how to generate %s format source package (missing vcs specifier in Format field?)"), $1));
> + }
> + if ($1 > 1.0) {
> + error(sprintf(_g("don't know how to generate %s format source package"), $1));
> + }
> + }
> + elsif ($f{Format} =~ /^\s*(\d+(?:\.\d+)?)\s+\((\w+)\)\s*$/) {
> + $f{Format}=$1;
> + if ($1 < 3.0) {
> + error(sprintf(_g("control info file 'Format' field for version %s does not support vcs specifier \"%s\""), $1, $2));
> + }
> + if ($1 >= 4) {
> + error(sprintf(_g("unsupported control info file 'Format' value \"%s\""), $1));
> + }
> +
> + $vcs=$2;
> + loadvcs($2)
> + || error(sprintf(_g("unsupported vcs \"%s\" in control info file 'Format' field"), $2));
> +
> + if ($sourcestyle =~ /[akpursKPUR]/) {
> + warning(sprintf(_g("source handling style -s%s not supported when generating %s format source package"), $sourcestyle, $vcs));
> + }
> + $sourcestyle='v';
> + }
> +
> + $sourcestyle =~ y/X/A/;
> + $sourcestyle =~ m/[akpursnAKPURv]/ ||
> + &usageerr(sprintf(_g("source handling style -s%s not allowed with -b"), $sourcestyle));
> +
>
> $f{'Binary'}= join(', ',@binarypackages);
> for my $f (keys %override) {
> @@ -438,7 +474,17 @@ if ($opmode eq 'build') {
> my $tardirbase;
> my $origdirname;
>
> - if ($sourcestyle ne 'n') {
> + if ($sourcestyle eq 'v') {
> + $tarname="$basenamerev.$vcs.tar.gz";
> + $tardirbase= $dirbase; $tardirname= "$tarname.tmp";
> +
> + eval qq{Dpkg::Source::VCS::${vcs}::prep_tar(\$dir, \$tardirname)};
> + if ($@) {
> + &syserr($@);
> + }
> + push @exit_handlers, sub { erasedir($tardirname) };
> + }
> + elsif ($sourcestyle ne 'n') {
> my $origdirbase = $origdir;
> $origdirbase =~ s,/?$,,;
> $origdirbase =~ s,[^/]+$,,; $origdirname= $&;
> @@ -458,10 +504,10 @@ if ($opmode eq 'build') {
> $tarname= "$basenamerev.tar.gz";
> }
>
> - if ($sourcestyle =~ m/[nurUR]/) {
> + if ($sourcestyle =~ m/[nurURv]/) {
>
> if (stat($tarname)) {
> - $sourcestyle =~ m/[nUR]/ ||
> + $sourcestyle =~ m/[nURv]/ ||
> &error(sprintf(_g("tarfile `%s' already exists, not overwriting,".
> " giving up; use -sU or -sR to override"), $tarname));
> } elsif ($! != ENOENT) {
> @@ -489,7 +535,7 @@ if ($opmode eq 'build') {
> &syserr(sprintf(_g("unable to rename `%s' (newly created) to `%s'"), $newtar, $tarname));
> chmod(0666 &~ umask(), $tarname) ||
> &syserr(sprintf(_g("unable to change permission of `%s'"), $tarname));
> -
> +
Whitespace changes?
> } else {
>
> printf(_g("%s: building %s using existing %s")."\n",
> @@ -530,6 +576,10 @@ if ($opmode eq 'build') {
> &syserr(sprintf(_g("unable to remove `%s'"), "$origtargz.tmp-nest"));
> pop @exit_handlers;
> }
> +
> + if ($sourcestyle eq 'v') {
> + erasedir($tardirname)
> + }
>
> if ($sourcestyle =~ m/[kpursKPUR]/) {
>
> @@ -790,6 +840,7 @@ if ($opmode eq 'build') {
> my @tarfiles;
> my $difffile;
> my $debianfile;
> + my %vcsfiles;
> my %seen;
> for my $file (split(/\n /, $files)) {
> next if $file eq '';
> @@ -813,6 +864,11 @@ if ($opmode eq 'build') {
> else { unshift @tarfiles, $file; }
> } elsif (/^\.debian\.tar$/) {
> $debianfile = $file;
> + } elsif (/^\.(\w+)\.tar$/) {
> + my $vcs=$1;
> + # TODO try to load vcs module
> + push @tarfiles, $file;
> + $vcsfiles{$file}=$vcs;
> } elsif (/^\.diff$/) {
> $difffile = $file;
> } else {
> @@ -825,14 +881,17 @@ if ($opmode eq 'build') {
> if ($native) {
> warning(_g("multiple tarfiles in native package")) if @tarfiles > 1;
> warning(_g("native package with .orig.tar"))
> - unless $seen{'.tar'} or $seen{"-$revision.tar"};
> + unless $seen{'.tar'} or $seen{"-$revision.tar"} or %vcsfiles;
> } else {
> - warning(_g("no upstream tarfile in Files field")) unless $seen{'.orig.tar'};
> + warning(_g("no upstream tarfile in Files field")) unless $seen{'.orig.tar'} or %vcsfiles;
> if ($dscformat =~ /^1\./) {
> warning(sprintf(_g("multiple upstream tarballs in %s format dsc"), $dscformat)) if @tarfiles > 1;
> warning(sprintf(_g("debian.tar in %s format dsc"), $dscformat)) if $debianfile;
> }
> }
> + if (%vcsfiles && $dscformat !~ /^3\./) {
> + warning(sprintf(_g("<rc>.tar file in %s format dsc"), $dscformat));
> + }
>
>
> $newdirectory = $sourcepackage.'-'.$baseversion unless defined($newdirectory);
> $expectprefix = $newdirectory;
> @@ -908,6 +967,16 @@ if ($opmode eq 'build') {
> $? && subprocerr("cp $expectprefix to $newdirectory.tmp-keep");
> }
> }
> +
> + if (exists $vcsfiles{$tarfile}) {
> + printf(_g("%s: extracting source from %s repository")."\n", $progname, $vcsfiles{$tarfile});
> + loadvcs($vcsfiles{$tarfile})
> + || error(sprintf(_g("unsupported vcs \"%s\""), $vcsfiles{$tarfile}));
> + eval qq{Dpkg::Source::VCS::$vcsfiles{$tarfile}::post_unpack_tar(\$target)};
> + if ($@) {
> + &syserr($@);
> + }
> + }
> }
>
> my @patches;
Gruesse,
--
Frank Lichtenheld <djpig@debian.org>
www: http://www.djpig.de/
Reply to: