193 lines
		
	
	
	
		
			5.6 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			193 lines
		
	
	
	
		
			5.6 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
use strict;
 | 
						|
 | 
						|
 | 
						|
sub addPatch {
 | 
						|
    my $patches = shift;
 | 
						|
    my $storePath = shift;
 | 
						|
    my $patch = shift;
 | 
						|
 | 
						|
    $$patches{$storePath} = []
 | 
						|
        unless defined $$patches{$storePath};
 | 
						|
 | 
						|
    my $patchList = $$patches{$storePath};
 | 
						|
 | 
						|
    my $found = 0;
 | 
						|
    foreach my $patch2 (@{$patchList}) {
 | 
						|
        if ($patch2->{url} eq $patch->{url}) {
 | 
						|
            if ($patch2->{hash} eq $patch->{hash}) {
 | 
						|
                $found = 1 if ($patch2->{basePath} eq $patch->{basePath});
 | 
						|
            } else {
 | 
						|
                die "conflicting hashes for URL $patch->{url}, " .
 | 
						|
                    "namely $patch2->{hash} and $patch->{hash}";
 | 
						|
            }
 | 
						|
        }
 | 
						|
    }
 | 
						|
    
 | 
						|
    push @{$patchList}, $patch if !$found;
 | 
						|
 | 
						|
    return !$found;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
sub readManifest {
 | 
						|
    my $manifest = shift;
 | 
						|
    my $narFiles = shift;
 | 
						|
    my $patches = shift;
 | 
						|
    my $successors = shift;
 | 
						|
 | 
						|
    open MANIFEST, "<$manifest";
 | 
						|
 | 
						|
    my $inside = 0;
 | 
						|
    my $type;
 | 
						|
 | 
						|
    my $storePath;
 | 
						|
    my $url;
 | 
						|
    my $hash;
 | 
						|
    my $size;
 | 
						|
    my @preds;
 | 
						|
    my $basePath;
 | 
						|
    my $baseHash;
 | 
						|
    my $patchType;
 | 
						|
    my $narHash;
 | 
						|
 | 
						|
    while (<MANIFEST>) {
 | 
						|
        chomp;
 | 
						|
        s/\#.*$//g;
 | 
						|
        next if (/^$/);
 | 
						|
 | 
						|
        if (!$inside) {
 | 
						|
 | 
						|
            if (/^\s*(\w*)\s*\{$/) {
 | 
						|
                $type = $1;
 | 
						|
                $type = "narfile" if $type eq "";
 | 
						|
                $inside = 1;
 | 
						|
                undef $storePath;
 | 
						|
                undef $url;
 | 
						|
                undef $hash;
 | 
						|
                undef $size;
 | 
						|
                @preds = ();
 | 
						|
                undef $narHash;
 | 
						|
                undef $basePath;
 | 
						|
                undef $baseHash;
 | 
						|
                undef $patchType;
 | 
						|
	    }
 | 
						|
 | 
						|
        } else {
 | 
						|
            
 | 
						|
            if (/^\}$/) {
 | 
						|
                $inside = 0;
 | 
						|
 | 
						|
                if ($type eq "narfile") {
 | 
						|
 | 
						|
                    $$narFiles{$storePath} = []
 | 
						|
                        unless defined $$narFiles{$storePath};
 | 
						|
 | 
						|
                    my $narFileList = $$narFiles{$storePath};
 | 
						|
 | 
						|
                    my $found = 0;
 | 
						|
                    foreach my $narFile (@{$narFileList}) {
 | 
						|
                        if ($narFile->{url} eq $url) {
 | 
						|
                            if ($narFile->{hash} eq $hash) {
 | 
						|
                                $found = 1;
 | 
						|
                            } else {
 | 
						|
                                die "conflicting hashes for URL $url, " .
 | 
						|
                                    "namely $narFile->{hash} and $hash";
 | 
						|
                            }
 | 
						|
                        }
 | 
						|
                    }
 | 
						|
                    if (!$found) {
 | 
						|
                        push @{$narFileList},
 | 
						|
                            { url => $url, hash => $hash, size => $size
 | 
						|
                            , narHash => $narHash
 | 
						|
                            };
 | 
						|
                    }
 | 
						|
                
 | 
						|
                    foreach my $p (@preds) {
 | 
						|
                        $$successors{$p} = $storePath;
 | 
						|
                    }
 | 
						|
 | 
						|
                }
 | 
						|
 | 
						|
                elsif ($type eq "patch") {
 | 
						|
                    addPatch $patches, $storePath,
 | 
						|
                        { url => $url, hash => $hash, size => $size
 | 
						|
                        , basePath => $basePath, baseHash => $baseHash
 | 
						|
                        , narHash => $narHash, patchType => $patchType
 | 
						|
                        };
 | 
						|
                }
 | 
						|
 | 
						|
            }
 | 
						|
            
 | 
						|
            elsif (/^\s*StorePath:\s*(\/\S+)\s*$/) { $storePath = $1; }
 | 
						|
            elsif (/^\s*Hash:\s*(\S+)\s*$/) { $hash = $1; }
 | 
						|
            elsif (/^\s*URL:\s*(\S+)\s*$/) { $url = $1; }
 | 
						|
            elsif (/^\s*Size:\s*(\d+)\s*$/) { $size = $1; }
 | 
						|
            elsif (/^\s*SuccOf:\s*(\/\S+)\s*$/) { push @preds, $1; }
 | 
						|
            elsif (/^\s*BasePath:\s*(\/\S+)\s*$/) { $basePath = $1; }
 | 
						|
            elsif (/^\s*BaseHash:\s*(\S+)\s*$/) { $baseHash = $1; }
 | 
						|
            elsif (/^\s*Type:\s*(\S+)\s*$/) { $patchType = $1; }
 | 
						|
            elsif (/^\s*NarHash:\s*(\S+)\s*$/) { $narHash = $1; }
 | 
						|
 | 
						|
            # Compatibility;
 | 
						|
            elsif (/^\s*NarURL:\s*(\S+)\s*$/) { $url = $1; }
 | 
						|
            elsif (/^\s*MD5:\s*(\S+)\s*$/) { $hash = $1; }
 | 
						|
 | 
						|
        }
 | 
						|
    }
 | 
						|
 | 
						|
    close MANIFEST;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
sub writeManifest
 | 
						|
{
 | 
						|
    my $manifest = shift;
 | 
						|
    my $narFiles = shift;
 | 
						|
    my $patches = shift;
 | 
						|
    my $successors = shift;
 | 
						|
 | 
						|
    open MANIFEST, ">$manifest.tmp"; # !!! check exclusive
 | 
						|
 | 
						|
    foreach my $storePath (keys %{$narFiles}) {
 | 
						|
        my $narFileList = $$narFiles{$storePath};
 | 
						|
        foreach my $narFile (@{$narFileList}) {
 | 
						|
            print MANIFEST "{\n";
 | 
						|
            print MANIFEST "  StorePath: $storePath\n";
 | 
						|
            print MANIFEST "  NarURL: $narFile->{url}\n";
 | 
						|
            print MANIFEST "  MD5: $narFile->{hash}\n";
 | 
						|
            print MANIFEST "  NarHash: $narFile->{narHash}\n";
 | 
						|
            print MANIFEST "  Size: $narFile->{size}\n";
 | 
						|
            foreach my $p (keys %{$successors}) { # !!! quadratic
 | 
						|
                if ($$successors{$p} eq $storePath) {
 | 
						|
                    print MANIFEST "  SuccOf: $p\n";
 | 
						|
                }
 | 
						|
            }
 | 
						|
            print MANIFEST "}\n";
 | 
						|
        }
 | 
						|
    }
 | 
						|
    
 | 
						|
    foreach my $storePath (keys %{$patches}) {
 | 
						|
        my $patchList = $$patches{$storePath};
 | 
						|
        foreach my $patch (@{$patchList}) {
 | 
						|
            print MANIFEST "patch {\n";
 | 
						|
            print MANIFEST "  StorePath: $storePath\n";
 | 
						|
            print MANIFEST "  NarURL: $patch->{url}\n";
 | 
						|
            print MANIFEST "  MD5: $patch->{hash}\n";
 | 
						|
            print MANIFEST "  NarHash: $patch->{narHash}\n";
 | 
						|
            print MANIFEST "  Size: $patch->{size}\n";
 | 
						|
            print MANIFEST "  BasePath: $patch->{basePath}\n";
 | 
						|
            print MANIFEST "  BaseHash: $patch->{baseHash}\n";
 | 
						|
            print MANIFEST "  Type: $patch->{patchType}\n";
 | 
						|
            print MANIFEST "}\n";
 | 
						|
        }
 | 
						|
    }
 | 
						|
    
 | 
						|
    
 | 
						|
    close MANIFEST;
 | 
						|
 | 
						|
    rename("$manifest.tmp", $manifest)
 | 
						|
        or die "cannot rename $manifest.tmp: $!";
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
return 1;
 |