Re: Command queuing with dpkg à la update-menus

[Bill Allombert <allomber@math.u-bordeaux.fr>]

Hello developers,

For those interested by dpkg hooks, I have rewritten the emulation
process used by update-menus in the above perl script.  

This is supposed to be used as follows:

fnord-*.postinst:
if [ -x /usr/bin/update-fnord ]; then
  dpkg-hook /usr/bin/update-fnord
fi

Now, I don't know what to do with it. I realize in-dpkg support
would be much better but there is no reason only update-menus
can use such  5 year old trick.

Thanks go to Torsten Hilbrich and Philippe Troin
for their help with the fcntl stuff.

I have a C implementation available if necessary.

FAQ:
Q: This is an awful kludge.
A: Yes.
Q: Why write it in perl ?
A: Because it is already availabe in C.

Cheers,
-- 
Bill. <ballombe@debian.org>

Imagine a large red swirl here. 


#! /usr/bin/perl
# Copyleft 2003 - Bill Allombert <ballombe@debian.org> 
# Released under the GPL

=head1 NAME

dpkg-hook - dpkg hook emulation for postinst/prerm scripts

=head1 SYNOPSIS

dpkg-hook <program>

=head1 DESCRIPTION

This is meant to be used in postinst/prerm scripts.
Trigger the execution of <program> when dpkg return.
The command is run once even if 'dpkg-hook command' 
has been invoked several time.
<program> must be suitable to run in the background.

Users must not depend on <program> being run at most
once, so it is preferable if program is idempotent.

The purpose is to avoid idempotent commands to be run
several time and slow down dpkg when only the last
run is needed.

=head1 AUTHOR

Bill Allombert <ballombe@debian.org>

=cut

$command=shift;
$LOCK="/var/run/dpkg-hook_$command.pid";
$DPKG_LOCK="/var/lib/dpkg/lock";

sub check_dpkglock()
{
  use Fcntl qw(F_WRLCK SEEK_SET F_GETLK F_UNLCK);

  sysopen DPKG_LOCKFILE, $DPKG_LOCK, O_RDWR|O_CREAT|O_TRUNC,0660
    or die("dpkg lockfile: $!");

  use Config;
  my $packspec = $Config{'uselargefiles'} ? "ssqql" : "sslll";
  my $fl=pack($packspec,F_WRLCK,SEEK_SET,0,0,0);
  fcntl DPKG_LOCKFILE,F_GETLK, $fl or die("fcntl: getlock: $!");
  ($state)=unpack($packspec,$fl);
  close DPKG_LOCKFILE;

  return $state!=F_UNLCK;
}

#Taken from perlipc man page.
sub daemonize {
  chdir '/'               or die "Can't chdir to /: $!";
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null'
    or die "Can't write to /dev/null: $!";
  defined(my $pid = fork) or die "Can't fork: $!";
  exit if $pid;
  setsid                  or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

sub dolock
{
  use Fcntl qw(LOCK_EX LOCK_NB);
  sysopen LOCKFILE, "$LOCK", O_WRONLY|O_CREAT, 0644
    or die ("$LOCK: $!");
  if (flock(LOCKFILE,LOCK_EX|LOCK_NB))
  {
    print LOCKFILE "$$\n";
  }
  else
  {
    print "cant lock $LOCK\n";
    exit 1;
  }
}

&dolock;
if(&check_dpkglock)
{
  print "daemon mode\n";
  &daemonize();
  while(&check_dpkglock()) {sleep 2;}
}
system {$command};
unlink $LOCK;