about summary refs log tree commit diff
path: root/scripts/copy-from-other-stores.pl.in
blob: 00de3ff9991e213aa54e0c2eff576ed108e44967 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
#! @perl@ -w

use strict;
use File::Basename;
use IO::Handle;

STDOUT->autoflush(1);

my @remoteStoresAll = split ':', ($ENV{"NIX_OTHER_STORES"} or "");

my @remoteStores;
foreach my $dir (@remoteStoresAll) {
    push @remoteStores, glob($dir);
}


sub findStorePath {
    my $storePath = shift;
    
    my $storePathName = basename $storePath;
    
    foreach my $store (@remoteStores) {
        # Determine whether $storePath exists by looking for the
        # existence of the info file, and if so, get store path info
        # from that file.  This rather breaks abstraction: we should
        # be using `nix-store' for that.  But right now there is no
        # good way to tell nix-store to access a store mounted under a
        # different location (there's $NIX_STORE, but that only works
        # if the remote store is mounted under its "real" location).
        my $infoFile = "$store/var/nix/db/info/$storePathName";
        my $storePath2 = "$store/store/$storePathName";
        if (-f $infoFile && -e $storePath2) {
            return ($infoFile, $storePath2);
        }
    }
}


if ($ARGV[0] eq "--query") {

    while (<STDIN>) {
        my $cmd = $_; chomp $cmd;

        if ($cmd eq "have") {
            my $storePath = <STDIN>; chomp $storePath;
            (my $infoFile) = findStorePath $storePath;
            print STDOUT ($infoFile ? "1\n" : "0\n");
        }

        elsif ($cmd eq "info") {
            my $storePath = <STDIN>; chomp $storePath;
            (my $infoFile) = findStorePath $storePath;
            if (!$infoFile) {
                print "0\n";
                next; # not an error
            }
            print "1\n";

            my $deriver = "";
            my @references = ();

            open INFO, "<$infoFile" or die "cannot read info file $infoFile\n";
            while (<INFO>) {
                chomp;
                /^([\w-]+): (.*)$/ or die "bad info file";
                my $key = $1;
                my $value = $2;
                if ($key eq "Deriver") { $deriver = $value; }
                elsif ($key eq "References") { @references = split ' ', $value; }
            }
            close INFO;

            print "$deriver\n";
            print scalar @references, "\n";
            print "$_\n" foreach @references;
        }

        else { die "unknown command `$cmd'"; }
    }
}


elsif ($ARGV[0] eq "--substitute") {
    die unless scalar @ARGV == 2;
    my $storePath = $ARGV[1];
    (my $infoFile, my $sourcePath) = findStorePath $storePath;
    die unless $infoFile;
    print "\n*** Copying `$storePath' from `$sourcePath'\n\n";
    system("@bindir@/nix-store --dump $sourcePath | @bindir@/nix-store --restore $storePath") == 0
        or die "cannot copy `$sourcePath' to `$storePath'";
}


else { die; }