Skip to content
This repository
tag: release_0_27_2
file 132 lines (108 sloc) 3.865 kb
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
#!/usr/bin/perl
# -*- mode: Perl; tab-width: 4; -*-
# vim: ts=4 sw=4 noet

use warnings;
use strict;

use Fcntl qw(:DEFAULT :seek);
use POSIX qw(:errno_h);

my $dryrun = 0;
if (@ARGV == 1 && $ARGV[0] eq '--dry-run') {
$dryrun = 1;
} elsif (@ARGV) {
die "Usage: $0 [--dry-run]\n";
}

if ($> != 0 && !$dryrun) {
die "$0 can only be run as root, except in --dry-run mode.\n";
}

### KEEP THIS IN SYNC WITH lockwait.in !!! ###

my $basepath = "@PREFIX@"; # Path prefix for dpkg
my $timeout = 5 * 60; # Seconds to wait before failing
my $debug = 0; # Print nice debug messages?

if ($> == 0 && !$dryrun) {
print STDERR "We're root, gonna pre-lock\n" if $debug;

print STDERR "Opening the lockfile\n" if $debug;
my $lockfile = "$basepath/var/lib/dpkg/lock";
open LOCK, ">$lockfile" or die "lockwait: Can't open: $!";

print STDERR "Locking it\n" if $debug;
### Note this pack() is specific to OS X and Darwin!!!
# fcntl.h declares:
# struct flock {
# off_t l_start; /* starting offset */
# off_t l_len; /* len = 0 means until end of file */
# pid_t l_pid; /* lock owner */
# short l_type; /* lock type: read/write, etc. */
# short l_whence; /* type of l_start */
# };
my $struct_flock = pack("lllliss", (0, 0), (0, 0), 0, F_WRLCK, SEEK_SET);
my $lock_ok = fcntl(LOCK, F_SETLK, $struct_flock);
unless ($lock_ok || $! == EOPNOTSUPP || $! == ENOLCK) {
die "lockwait: Can't get lock: $!" unless $! == EAGAIN || $! == EACCES;

my $msg = $timeout ? "up to $timeout seconds " : "";
print STDERR "Waiting ${msg}for access to the dpkg database... ";
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $timeout if $timeout;
print STDERR "Waiting for lock, timeout = $timeout\n" if $debug;
($lock_ok = fcntl(LOCK, F_SETLKW, $struct_flock)) or
die "lockwait: Can't get lock or wait: $!";
alarm 0;
};
if ($@) {
die unless $@ eq "alarm\n";
print STDERR "\nTimed out, cancelling operation!\n";
exit(1);
}
print STDERR "done.\n";
}
print STDERR "Got the lock\n" if $debug && $lock_ok;
print STDERR "WARNING: No locking is available on this filesystem.\n" .
"To ensure safety, do not run multiple instances simultaneously.\n"
if !$lock_ok;
}

### END OF lockwait.in INCLUDED CODE ###

my $status_file = $basepath . '/var/lib/dpkg/status';
my $status_back = $status_file . '.' . time . '.' . $$;
my $status_temp = $status_file . '.new';

umask 0022;

open my $status_old, '<', $status_file or die "Couldn't read $status_file: $!\n";

my $status_new; # filehandle
if (!$dryrun) {
open $status_new, '>', $status_temp or die "Couldn't write $status_temp: $!\n";

$debug && print "processing $status_file -> $status_temp\n";
}

my $para = '';
my $omit = 0;
my ($cnt_omit, $cnt_keep) = (0,0);
while (defined(my $line = <$status_old>)) {
    $para .= $line;
    if ($line =~ /\As*\Z/ or eof($status_old)) {
# end of paragraph...store if not flagged to omit
if ($omit) {
$cnt_omit++;
$debug && print "=====\nomit:\n-----\n$para";
} else {
$cnt_keep++;
$debug && print "=====\nkeep:\n-----\n$para";
print $status_new $para if !$dryrun; # write to new database
}
$omit = 0;
$para = '';
    } else {
# some random paragraph line...
if ($line eq "Status: purge ok not-installed\n") {
$omit = 1; # package is purged...flag to omit it
}
    }
}

close $status_old;

if (!$dryrun) {
close $status_new;

$debug && print "=====\nrename $status_file -> $status_back\n";
rename $status_file, $status_back or die "Couldn't rename $status_file to $status_back\n";

$debug && print "rename $status_temp -> $status_file\n";
rename $status_temp, $status_file or die "Couldn't install $status_temp as $status_file\n";
}

print "$status_file cleanup:\n\tkeep $cnt_keep\n\tomit $cnt_omit\n";

if (!$dryrun) {
}

exit 0;
Something went wrong with that request. Please try again.