/usr/sbin/update-dlocatedb is in dlocate 1.02.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | #!/usr/bin/perl
# perl script originally by hallon@debian.org, much faster than sed & sh.
#
# modified by cas to pipe its output through frcode and then > to the
# db file.
#
# caching of .list timestamps and re-use of old locatedb data added by
# Pawel Chmielowski <prefiks@prefiks.org>, see Bug #457572
# 2009-05-30 Craig Sanders <cas@taz.net.au>
# - rewrote script to output a plain text listing rather than use frcode
#
# 2009-06-03 # Craig Sanders <cas@taz.net.au>
# - added optional support for compressing /var/lib/dlocatedb
use strict;
use File::Basename;
my $program = basename($0);
my $dbfile='/var/lib/dlocate/dlocatedb';
my $stampsfile='/var/lib/dlocate/dlocatedb.stamps';
#my $dbfile='/tmp/dlocate';
#my $stampsfile='/tmp/dlocate.stamps';
my $infodir='/var/lib/dpkg/info';
my $compress=0;
my $defaults='/etc/default/dlocate';
if (open(DEFAULTS,'<', $defaults)) {
while (<DEFAULTS>) {
chomp;
s/#.*|^\s*|\s*$//g;
next if (/^$/);
s/\s|"//g;
my ($key,$val) = split /=/;
if ($key eq 'COMPRESS_DLOCATE') {
$compress = $val;
};
};
close(DEFAULTS);
};
my (%old_stamps, %stamps);
if (open(STAMPS, '<', $stampsfile)) {
while (<STAMPS>) {
chomp;
my ($stamp, $file) = split /:/, $_, 2;
$old_stamps{$file} = $stamp;
}
close(STAMPS);
}
open(DBFILE,'>', "$dbfile.new") or die "$program: couldn't open $dbfile.new for write: $!\n";
opendir(DIR, $infodir) or die "$program: can't open directory $infodir: $!\n";
while (defined(my $pkg = readdir(DIR))) {
next unless $pkg =~ s/\.list$// and -s "$infodir/$pkg.list";
$stamps{$pkg} = (stat(_))[10]; #ctime
}
closedir DIR;
my @new_pkgs;
my %processed;
chdir $infodir;
if (%old_stamps and open(DB, '<', $dbfile)) {
while (<DB>) {
my ($pkg) = /^(\S+?):/;
if (not exists $stamps{$pkg}) {
# skip packages which are no longer installed
} elsif (exists $old_stamps{$pkg} and $stamps{$pkg} == $old_stamps{$pkg}) {
print DBFILE $_;
} elsif (not exists $processed{$pkg}) {
open(FILE, "$pkg.list") or die "$program: can't open file $pkg.list: $!\n";
foreach (<FILE>) {
print DBFILE "$pkg: $_";
}
close FILE;
}
$processed{$pkg} = 1;
}
close(DB);
my %tmp = %stamps;
delete $tmp{$_} for keys %processed;
@new_pkgs = keys %tmp;
} else {
@new_pkgs = keys %stamps;
}
foreach my $pkg (@new_pkgs) {
open(FILE, '<', "$pkg.list") or die "$program: can't open $pkg for read: $!\n";
foreach (<FILE>) {
print DBFILE $pkg, ': ', $_;
}
close FILE;
}
# append diversions info to dlocatedb
my $divfile = '/var/lib/dpkg/diversions';
open(DIVERSIONS,"<",$divfile) or die "$program: can't open $divfile for read: $!\n";
while (my $from = <DIVERSIONS>) {
my $to = <DIVERSIONS>;
my $pkg = <DIVERSIONS>;
chomp($from, $to, $pkg);
print DBFILE "diversion by $pkg from: $from\n";
print DBFILE "diversion by $pkg to: $to\n";
}
close(DIVERSIONS);
close DBFILE;
# Create a backup to the database before replacing it with the new database.
# This is effectively two rename's done atomically.
if (-e $dbfile) {
unlink("$dbfile.old") if (-e "$dbfile.old");
link($dbfile, "$dbfile.old") if (-e $dbfile);
}
rename("$dbfile.new", $dbfile);
# optionally compress dlocatedb
if ($compress eq "1") {
system('gzip','--quiet','--force',$dbfile);
rename("$dbfile.gz", $dbfile);
};
open(STAMPS, '>', "$stampsfile.new") or die "$program: can't create stamps file $stampsfile.new: $!\n";
print STAMPS "$stamps{$_}:$_\n" for keys %stamps;
close STAMPS;
if (-e $stampsfile) {
unlink($stampsfile);
};
rename("$stampsfile.new", $stampsfile);
|