lix-releng-staging/scripts/NixManifest.pm.in

use strict;
use DBI;
use Cwd;
use File::stat;


sub addPatch {
    my ($patches, $storePath, $patch) = @_;

    $$patches{$storePath} = []
        unless defined $$patches{$storePath};

    my $patchList = $$patches{$storePath};

    my $found = 0;
    foreach my $patch2 (@{$patchList}) {
        $found = 1 if
            $patch2->{url} eq $patch->{url} &&
            $patch2->{basePath} eq $patch->{basePath};
    }
    
    push @{$patchList}, $patch if !$found;

    return !$found;
}


sub readManifest {
    my ($manifest, $narFiles, $patches) = @_;

    open MANIFEST, "<$manifest"
        or die "cannot open `$manifest': $!";

    my $inside = 0;
    my $type;

    my $manifestVersion = 2;

    my ($storePath, $url, $hash, $size, $basePath, $baseHash, $patchType);
    my ($narHash, $narSize, $references, $deriver, $copyFrom, $system);

    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;
                undef $narHash;
                undef $narSize;
                undef $basePath;
                undef $baseHash;
                undef $patchType;
                undef $system;
                $references = "";
                $deriver = "";
	    }

        } 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}) {
                        $found = 1 if $narFile->{url} eq $url;
                    }
                    if (!$found) {
                        push @{$narFileList},
                            { url => $url, hash => $hash, size => $size
                            , narHash => $narHash, narSize => $narSize
                            , references => $references
                            , deriver => $deriver
                            , system => $system
                            };
                    }
                
                }

                elsif ($type eq "patch") {
                    addPatch $patches, $storePath,
                        { url => $url, hash => $hash, size => $size
                        , basePath => $basePath, baseHash => $baseHash
                        , narHash => $narHash, narSize => $narSize
                        , patchType => $patchType
                        };
                }

            }
            
            elsif (/^\s*StorePath:\s*(\/\S+)\s*$/) { $storePath = $1; }
            elsif (/^\s*CopyFrom:\s*(\/\S+)\s*$/) { $copyFrom = $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*$/) { } # obsolete
            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; }
            elsif (/^\s*NarSize:\s*(\d+)\s*$/) { $narSize = $1; }
            elsif (/^\s*References:\s*(.*)\s*$/) { $references = $1; }
            elsif (/^\s*Deriver:\s*(\S+)\s*$/) { $deriver = $1; }
            elsif (/^\s*ManifestVersion:\s*(\d+)\s*$/) { $manifestVersion = $1; }
            elsif (/^\s*System:\s*(\S+)\s*$/) { $system = $1; }

            # Compatibility;
            elsif (/^\s*NarURL:\s*(\S+)\s*$/) { $url = $1; }
            elsif (/^\s*MD5:\s*(\S+)\s*$/) { $hash = "md5:$1"; }

        }
    }

    close MANIFEST;

    return $manifestVersion;
}


sub writeManifest {
    my ($manifest, $narFiles, $patches, $noCompress) = @_;

    open MANIFEST, ">$manifest.tmp"; # !!! check exclusive

    print MANIFEST "version {\n";
    print MANIFEST "  ManifestVersion: 3\n";
    print MANIFEST "}\n";

    foreach my $storePath (sort (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 "  Hash: $narFile->{hash}\n" if defined $narFile->{hash};
            print MANIFEST "  Size: $narFile->{size}\n" if defined $narFile->{size};
            print MANIFEST "  NarHash: $narFile->{narHash}\n";
            print MANIFEST "  NarSize: $narFile->{narSize}\n" if $narFile->{narSize};
            print MANIFEST "  References: $narFile->{references}\n"
                if defined $narFile->{references} && $narFile->{references} ne "";
            print MANIFEST "  Deriver: $narFile->{deriver}\n"
                if defined $narFile->{deriver} && $narFile->{deriver} ne "";
            print MANIFEST "  System: $narFile->{system}\n" if defined $narFile->{system};
            print MANIFEST "}\n";
        }
    }
    
    foreach my $storePath (sort (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 "  Hash: $patch->{hash}\n";
            print MANIFEST "  Size: $patch->{size}\n";
            print MANIFEST "  NarHash: $patch->{narHash}\n";
            print MANIFEST "  NarSize: $patch->{narSize}\n" if $patch->{narSize};
            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: $!";


    # Create a bzipped manifest.
    unless (defined $noCompress) {
	system("@bzip2@ < $manifest > $manifest.bz2.tmp") == 0
	    or die "cannot compress manifest";

	rename("$manifest.bz2.tmp", "$manifest.bz2")
	    or die "cannot rename $manifest.bz2.tmp: $!";
    }
}


sub updateManifestDB {
    my $manifestDir = ($ENV{"NIX_MANIFESTS_DIR"} or "@localstatedir@/nix/manifests");

    my $dbPath = "$manifestDir/cache.sqlite";

    # Open/create the database.
    my $dbh = DBI->connect("dbi:SQLite:dbname=$dbPath", "", "")
        or die "cannot open database `$dbPath'";
    $dbh->{AutoCommit} = 0;
    $dbh->{RaiseError} = 1;
    $dbh->{PrintError} = 0;

    $dbh->do("pragma foreign_keys = on");

    # Initialise the database schema, if necessary.
    $dbh->do(<<EOF);
        create table if not exists Manifests (
            id        integer primary key autoincrement not null,
            path      text unique not null,
            timestamp integer not null
        );
EOF
    
    $dbh->do(<<EOF);
        create table if not exists NARs (
            id               integer primary key autoincrement not null,
            manifest         integer not null,
            storePath        text not null,
            url              text not null,
            hash             text,
            size             integer,
            narHash          text,
            narSize          integer,
            refs             text,
            deriver          text,
            system           text,
            foreign key (manifest) references Manifests(id) on delete cascade
        );
EOF

    $dbh->do("create index if not exists NARs_storePath on NARs(storePath)");

    $dbh->do(<<EOF);
        create table if not exists Patches (
            id               integer primary key autoincrement not null,
            manifest         integer not null,
            storePath        text not null,
            basePath         text not null,
            baseHash         text not null,
            url              text not null,
            hash             text,
            size             integer,
            narHash          text,
            narSize          integer,
            patchType        text not null,
            foreign key (manifest) references Manifests(id) on delete cascade
        );
EOF

    $dbh->do("create index if not exists Patches_storePath on Patches(storePath)");

    # !!! locking?

    # Read each manifest in $manifestDir and add it to the database,
    # unless we've already done so on a previous run.
    my %seen;
    
    for my $manifest (glob "$manifestDir/*.nixmanifest") {
        $manifest = Cwd::abs_path($manifest);
        my $timestamp = lstat($manifest)->mtime;
        $seen{$manifest} = 1;

        next if scalar @{$dbh->selectcol_arrayref(
            "select 1 from Manifests where path = ? and timestamp = ?",
            {}, $manifest, $timestamp)} == 1;

        # !!! Insert directly into the DB.
        my %narFiles;
        my %patches;
        my $version = readManifest($manifest, \%narFiles, \%patches);
        
        if ($version < 3) {
            die "you have an old-style manifest `$manifest'; please delete it";
        }
        if ($version >= 10) {
            die "manifest `$manifest' is too new; please delete it or upgrade Nix";
        }

        $dbh->do("delete from Manifests where path = ?", {}, $manifest);
                 
        $dbh->do("insert into Manifests(path, timestamp) values (?, ?)",
                 {}, $manifest, $timestamp);

        my $id = $dbh->sqlite_last_insert_rowid();

        foreach my $storePath (keys %narFiles) {
            my $narFileList = $narFiles{$storePath};
            foreach my $narFile (@{$narFiles{$storePath}}) {
                $dbh->do(
                    "insert into NARs(manifest, storePath, url, hash, size, narHash, " .
                    "narSize, refs, deriver, system) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)",
                    {}, $id, $storePath, $narFile->{url}, $narFile->{hash}, $narFile->{size},
                    $narFile->{narHash}, $narFile->{narSize}, $narFile->{references},
                    $narFile->{deriver}, $narFile->{system});
            }
        }

        foreach my $storePath (keys %patches) {
            my $patchList = $patches{$storePath};
            foreach my $patch (@{$patchList}) {
                $dbh->do(
                    "insert into Patches(manifest, storePath, basePath, baseHash, url, hash, " .
                    "size, narHash, narSize, patchType) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)",
                    {}, $id, $storePath, $patch->{basePath}, $patch->{baseHash}, $patch->{url},
                    $patch->{hash}, $patch->{size}, $patch->{narHash}, $patch->{narSize},
                    $patch->{patchType});
            }
        }
    }

    # Removed cached information for removed manifests from the DB.
    foreach my $manifest (@{$dbh->selectcol_arrayref("select path from Manifests")}) {
        next if defined $seen{$manifest};
        $dbh->do("delete from Manifests where path = ?", {}, $manifest);
    }

    $dbh->commit;

    return $dbh;
}


return 1;