diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/Makefile.in | 79 | ||||
| -rw-r--r-- | scripts/dpkg-divert.pl | 220 | ||||
| -rw-r--r-- | scripts/dpkg-name.1 | 60 | ||||
| -rwxr-xr-x | scripts/dpkg-name.sh | 94 | ||||
| -rwxr-xr-x | scripts/dpkg-scanpackages.pl | 178 | ||||
| -rw-r--r-- | scripts/install-info.8 | 245 | ||||
| -rwxr-xr-x | scripts/install-info.pl | 342 | ||||
| -rw-r--r-- | scripts/lib.pl | 565 | ||||
| -rwxr-xr-x | scripts/perl-dpkg.pl | 1482 | ||||
| -rw-r--r-- | scripts/start-stop-daemon.8 | 19 | ||||
| -rwxr-xr-x | scripts/start-stop-daemon.pl | 160 | ||||
| -rw-r--r-- | scripts/update-alternatives.8 | 19 | ||||
| -rwxr-xr-x | scripts/update-alternatives.pl | 429 | ||||
| -rw-r--r-- | scripts/update-rc.d.8 | 79 | ||||
| -rwxr-xr-x | scripts/update-rc.d.sh | 104 |
15 files changed, 4075 insertions, 0 deletions
diff --git a/scripts/Makefile.in b/scripts/Makefile.in new file mode 100644 index 000000000..e3fe56dda --- /dev/null +++ b/scripts/Makefile.in @@ -0,0 +1,79 @@ +# Copyright (C) 1994 Ian Murdock <imurdock@debian.org> +# Copyright (C) 1994,1995 Ian Jackson <ijackson@nyx.cs.du.edu> +# +# This is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2, +# or (at your option) any later version. +# +# This is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public +# License along with dpkg; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +srcdir = @srcdir@ +VPATH = @srcdir@ + +prefix = @prefix@ +bindir = $(prefix)/bin +sbindir = $(prefix)/sbin +datadir = /var/lib/dpkg +altsdatadir = $(datadir)/alternatives +mandir = $(prefix)/man +man1dir = $(mandir)/man1 +man8dir = $(mandir)/man8 +man1 = 1 +man8 = 8 +libdir = $(prefix)/lib +dpkglibdir = $(libdir)/dpkg +etcdir= /etc +altsetcdir = $(etcdir)/alternatives +perlpath = @perlpath@ + +MAN1 = dpkg-name +EXC = dpkg-name +MAN8 = update-rc.d start-stop-daemon update-alternatives install-info +SBIN = update-rc.d start-stop-daemon update-alternatives install-info \ + dpkg-scanpackages dpkg-divert + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ + +.SUFFIXES: .pl .sh .gzuue + +.pl: + sed <$@.pl 's:^#!/usr/bin/perl:#!$(perlpath):' \ + | ../insert-version.pl >$@.new + chmod +x $@.new + mv $@.new $@ + +.sh: + sed <$@.sh 's:^dpkglibdir=/usr/lib/dpkg$$:dpkglibdir=$(dpkglibdir):' \ + | ../insert-version.pl >$@.new + mv $@.new $@ + +.gzuue: + uudecode <$@.gzuue + gunzip <$@.gz >$@.new + test ! -x $@.gz || chmod +x $@.new + rm $@.gz + mv $@.new $@ + +all: $(EXC) $(SBIN) + +clean: + rm -f $(EXC) $(SBIN) core *.new + +distclean: clean + rm -f Makefile *.orig *~ *.~* ./#*# i386elf-hello-world.gz + +install: all + for f in $(EXC) ; do $(INSTALL_PROGRAM) $$f $(bindir)/$$f ; done + for f in $(MAN1) ; do $(INSTALL_DATA) $$f.1 $(man1dir)/$$f.$(man1) ; done + for f in $(SBIN) ; do $(INSTALL_PROGRAM) $$f $(sbindir)/$$f ; done + for f in $(MAN8) ; do $(INSTALL_DATA) $$f.8 $(man8dir)/$$f.$(man8) ; done diff --git a/scripts/dpkg-divert.pl b/scripts/dpkg-divert.pl new file mode 100644 index 000000000..dff1854ca --- /dev/null +++ b/scripts/dpkg-divert.pl @@ -0,0 +1,220 @@ +#!/usr/bin/perl -- + +#use POSIX; &ENOENT; +sub ENOENT { 2; } +# Sorry about this, but POSIX.pm isn't necessarily available + +$version= '1.0.11'; # This line modified by Makefile +sub usageversion { + print(STDERR <<END) +Debian GNU/Linux dpkg-divert $version. Copyright (C) 1995 +Ian Jackson. This is free software; see the GNU General Public Licence +version 2 or later for copying conditions. There is NO warranty. + +Usage: + dpkg-divert [options] [--add] <file> + dpkg-divert [options] --remove <file> + dpkg-divert [options] --list [<glob-pattern>] + +Options: --package <package> | --local --divert <divert-to> --rename + --quiet --test --help|--version --admindir <directory> + +<package> is the name of a package whose copy of <file> will not be diverted. +<divert-to> is the name used by other packages' versions. +--local specifies that all packages' versions are diverted. +--rename causes dpkg-divert to actually move the file aside (or back). + +When adding, default is --local and --divert <original>.distrib. +When removing, --package or --local and --divert must match if specified. +Package preinst/postrm scripts should always specify --package and --divert. +END + || &quit("failed to write usage: $!"); +} + +$admindir= '/var/lib/dpkg'; +$testmode= 0; +$dorename= 0; +$verbose= 1; +$mode=''; +$|=1; + +sub checkmanymodes { + return unless $mode; + &badusage("two modes specified: $_ and --$mode"); +} + +while (@ARGV) { + $_= shift(@ARGV); + last if m/^--$/; + if (!m/^-/) { + unshift(@ARGV,$_); last; + } elsif (m/^--(help|version)$/) { + &usageversion; exit(0); + } elsif (m/^--test$/) { + $testmode= 1; + } elsif (m/^--rename$/) { + $dorename= 1; + } elsif (m/^--quiet$/) { + $verbose= 0; + } elsif (m/^--local$/) { + $package= ':'; + } elsif (m/^--add$/) { + &checkmanymodes; + $mode= 'add'; + } elsif (m/^--remove$/) { + &checkmanymodes; + $mode= 'remove'; + } elsif (m/^--list$/) { + &checkmanymodes; + $mode= 'list'; + } elsif (m/^--divert$/) { + @ARGV || &badusage("--divert needs a divert-to argument"); + $divertto= shift(@ARGV); + $divertto =~ m/\n/ && &badusage("divert-to may not contain newlines"); + } elsif (m/^--package$/) { + @ARGV || &badusage("--package needs a package argument"); + $package= shift(@ARGV); + $divertto =~ m/\n/ && &badusage("package may not contain newlines"); + } elsif (m/^--admindir$/) { + @ARGV || &badusage("--admindir needs a directory argument"); + $admindir= shift(@ARGV); + } else { + &badusage("unknown option \`$_'"); + } +} + +$mode='add' unless $mode; + +open(O,"$admindir/diversions") || &quit("cannot open diversions: $!"); +while(<O>) { + s/\n$//; push(@contest,$_); + $_=<O>; s/\n$// || &badfmt("missing altname"); + push(@altname,$_); + $_=<O>; s/\n$// || &badfmt("missing package"); + push(@package,$_); +} +close(O); + +if ($mode eq 'add') { + @ARGV == 1 || &badusage("--add needs a single argument"); + $file= $ARGV[0]; + $file =~ m/\n/ && &badusage("file may not contain newlines"); + $divertto= "$file.distrib" unless defined($divertto); + $package= ':' unless defined($package); + for ($i=0; $i<=$#contest; $i++) { + if ($contest[$i] eq $file || $altname[$i] eq $file || + $contest[$i] eq $divertto || $altname[$i] eq $divertto) { + if ($contest[$i] eq $file && $altname[$i] eq $divertto && + $package[$i] eq $package) { + print "Leaving \`",&infon($i),"'\n" if $verbose > 0; + exit(0); + } + &quit("\`".&infoa."' clashes with \`".&infon($i)."'"); + } + } + push(@contest,$file); + push(@altname,$divertto); + push(@package,$package); + print "Adding \`",&infon($#contest),"'\n" if $verbose > 0; + &checkrename($file,$divertto); + &save; + &dorename($file,$divertto); + exit(0); +} elsif ($mode eq 'remove') { + @ARGV == 1 || &badusage("--remove needs a single argument"); + $file= $ARGV[0]; + for ($i=0; $i<=$#contest; $i++) { + next unless $file eq $contest[$i]; + &quit("mismatch on divert-to\n when removing \`".&infoa."'\n found \`". + &infon($i)."'") if defined($divertto) && $altname[$i] ne $divertto; + &quit("mismatch on package\n when removing \`".&infoa."'\n found \`". + &infon($i)."'") if defined($package) && $package[$i] ne $package; + print "Removing \`",&infon($i),"'\n" if $verbose > 0; + $orgfile= $contest[$i]; + $orgdivertto= $altname[$i]; + @contest= (($i > 0 ? @contest[0..$i-1] : ()), + ($i < $#contest ? @contest[$i+1,$#contest] : ())); + @altname= (($i > 0 ? @altname[0..$i-1] : ()), + ($i < $#altname ? @altname[$i+1,$#altname] : ())); + @package= (($i > 0 ? @package[0..$i-1] : ()), + ($i < $#package ? @package[$i+1,$#package] : ())); + &checkrename($orgdivertto,$orgfile); + &dorename($orgdivertto,$orgfile); + &save; + exit(0); + } + print "No diversion \`",&infoa,"', none removed\n" if $verbose > 0; + exit(0); +} elsif ($mode eq 'list') { + @ilist= @ARGV ? @ARGV : ('*'); + while (defined($_=shift(@ilist))) { + s/\W/\\$&/g; + s/\\\?/./g; + s/\\\*/.*/g; + push(@list,"^$_\$"); + } + $pat= join('$|^',@list); + for ($i=0; $i<=$#contest; $i++) { + next unless ($contest[$i] =~ m/$pat/o || + $altname[$i] =~ m/$pat/o || + $package[$i] =~ m/$pat/o); + print &infon($i),"\n"; + } + exit(0); +} else { + &quit("internal error - bad mode \`$mode'"); +} + +sub infol { + return (($_[2] eq ':' ? "<local>" : length($_[2]) ? "$_[2]" : "<any>"). + ": $_[0]". + (length($_[1]) ? " -> $_[1]" : "")); +} + +sub checkrename { + return unless $dorename; + ($rsrc,$rdest) = @_; + (@ssrc= lstat($rsrc)) || $! == &ENOENT || + &quit("cannot stat old name \`$rsrc': $!"); + (@sdest= lstat($rdest)) || $! == &ENOENT || + &quit("cannot stat new name \`$rdest': $!"); + if (@ssrc && @sdest && + !($ssrc[0] == $sdest[0] && $ssrc[1] == $sdest[1])) { + &quit("rename involves overwriting \`$rdest' with\n". + " different file \`$rsrc', not allowed"); + } +} + +sub dorename { + return unless $dorename; + if (@ssrc) { + if (@sdest) { + unlink($rsrc) || &quit("rename: remove duplicate old link \`$rsrc': $!"); + } else { + rename($rsrc,$rdest) || &quit("rename: rename \`$rsrc' to \`$rdest': $!"); + } + } +} + +sub save { + return if $testmode; + open(N,"> $admindir/diversions-new") || &quit("create diversions-new: $!"); + for ($i=0; $i<=$#contest; $i++) { + print(N "$contest[$i]\n$altname[$i]\n$package[$i]\n") + || &quit("write diversions-new: $!"); + } + close(N) || &quit("close diversions-new: $!"); + unlink("$admindir/diversions-old") || + $! == &ENOENT || &quit("remove old diversions-old: $!"); + link("$admindir/diversions","$admindir/diversions-old") || + $! == &ENOENT || &quit("create new diversions-old: $!"); + rename("$admindir/diversions-new","$admindir/diversions") + || &quit("install new diversions: $!"); +} + +sub infoa { &infol($file,$divertto,$package); } +sub infon { &infol($contest[$i],$altname[$i],$package[$i]); } + +sub quit { print STDERR "dpkg-divert: @_\n"; exit(2); } +sub badusage { print STDERR "dpkg-divert: @_\n\n"; &usageversion; exit(2); } +sub badfmt { &quit("internal error: $admindir/diversions corrupt: $_[0]"); } diff --git a/scripts/dpkg-name.1 b/scripts/dpkg-name.1 new file mode 100644 index 000000000..b474feb8d --- /dev/null +++ b/scripts/dpkg-name.1 @@ -0,0 +1,60 @@ +.\" This is an -*- nroff -*- source file. +.\" dpkg-name and this manpage are Copyright 1995,1996 by Erick Branderhorst. +.\" +.\" This is free software; see the GNU General Public Licence version 2 +.\" or later for copying conditions. There is NO warranty. +.TH dpkg-name 1 "January 1996" "Debian Project" "Debian GNU/Linux" +.SH NAME +dpkg\-name \- rename Debian packages to full package names +.SH SYNOPSIS +.B dpkg\-name [\-h|\-\-help] [\-V|\-\-version] [\-L|\-\-license] [--] [files] +.SH DESCRIPTION +.PP +This manual page documents the +.B dpkg\-name +sh script which provides an easy way to rename +.B Debian +packages into their full package names. A full package name consists +of <package>-<version>[-<revision>].deb as specified in the control +file of the package. +.SH EXAMPLES +.TP +.B dpkg-name toedeledokie +The file `toedeledokie' will be renamed to emacs-19.29-4.deb or +something similar (depending on whatever information is in the control +part of `toedeledokie'). +.TP +.B find /root/debian/ \-name '*.deb' | xargs dpkg\-name +All files with the extension `deb' in the directory /root/debian and +its subdirectory's will be renamed by dpkg\-name if required. +.SS OPTIONS +.TP +.B "\-h, \-\-help" +Print a usage message and exit successfully. +.TP +.B "\-v, \-\-version" +Print version information and exit successfully. +.TP +.B "\-l, \-\-license" +Print copyright information and (a reference to GNU) license +information and exit successfully. +.SH BUGS? +Successfully tested on +.B Debian GNU/Linux +systems only. Some packages don't follow the name structure +<package>-<version>[-<revision>].deb. Packages renamed by dpkg-name +will follow this structure. Generally this will have no impact on how +packages are installed by dselect/dpkg. +.SH SEE ALSO +.BR deb (5), +.BR deb-control (5), +.BR dpkg (5), +.BR dpkg (8), +.BR dpkg-deb (8). +.SH COPYRIGHT +Copyright 1995,1996 Erick Branderhorst. +.B dpkg-name +is free software; see the GNU General Public Licence version 2 or +later for copying conditions. There is +.B no +warranty. diff --git a/scripts/dpkg-name.sh b/scripts/dpkg-name.sh new file mode 100755 index 000000000..294010aa9 --- /dev/null +++ b/scripts/dpkg-name.sh @@ -0,0 +1,94 @@ +#!/bin/sh + +set -e + +prog="`basename \"${0}\"`" +version="0.11"; # This line modified by Makefile +purpose="rename Debian packages to full package names" + +license () { +echo "# ${prog} ${version} -- ${purpose} +# Copyright (C) 1995,1996 Erick Branderhorst <branderhorst@heel.fgg.eur.nl>. + +# This is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any +# later version. + +# This is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file +# /usr/doc/copyright/GPL for more details." +} + +stderr () { + echo "${prog}: $@" >/dev/stderr; +} + +show_version () { + echo "${prog} version ${version} -- ${purpose}"; +} + +usage () { + echo "Usage: ${prog} file[s] + ${purpose} + file.deb changes to <package>-<version>[-<revision>].deb + -h|--help|-v|--version|-l|--license Show help/version/license" +} + +rename () { + if [ -f "$1" ]; + then + if p=`dpkg-deb -f -- "$1" package`; + then + p="$p-"`dpkg-deb -f -- "$1" version`; + r=`dpkg-deb -f -- "$1" revision`; + if [ -z "$r" ]; + then + r=`dpkg-deb -f -- "$1" package_revision`; + fi + if [ -n "$r" ]; + then + p=$p-$r; + fi + p=`echo $p|sed 's/ //g'` + p=`dirname "$1"`"/"$p.deb + if [ $p -ef "$1" ]; # same device and inode numbers + then + stderr "skipping \`"$1"'"; + elif [ -f $p ]; + then + stderr "can't move \`"$1"' to existing file"; + elif `mv -- "$1" $p`; + then + echo "moved \``basename "$1"`' to \`${p}'"; + else + stderr "hmm how did this happen?"; + fi + fi + else + stderr "can't deal with \`"$1"'"; + fi +} + +if [ $# = 0 ]; then usage; exit 0; fi +for arg +do + case "$arg" in + --version|-v) show_version; exit 0;; + --help|-[h?]) usage; exit 0;; + --licen[cs]e|-l) license; exit 0;; + --) shift; + for arg + do + rename "$arg"; + done; exit 0;; + *) rename "$arg";; + esac +done +exit 0; + +# Local variables: +# tab-width: 2 +# End: + diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl new file mode 100755 index 000000000..efb6a6e29 --- /dev/null +++ b/scripts/dpkg-scanpackages.pl @@ -0,0 +1,178 @@ +#!/usr/bin/perl -- +# usage: +# dpkg-scanpackages .../binary .../noverride pathprefix >.../Packages.new +# mv .../Packages.new .../Packages +# +# This is the core script that generates Packages files (as found +# on the Debian FTP site and CD-ROMs). +# +# The first argument should preferably be a relative filename, so that +# the Filename field has good information. +# +# Any desired string can be prepended to each Filename value by +# passing it as the third argument. +# +# The noverride file is a series of lines of the form +# <package> <priority> <section> <maintainer> +# where the <maintainer> field is optional. Fields are separated by +# whitespace. + +$version= '1.0.10'; # This line modified by Makefile + +%kmap= ('optional','suggests', + 'recommended','recommends', + 'class','priority', + 'package_revision','revision'); + +%pri= ('priority',300, + 'section',290, + 'maintainer',280, + 'version',270, + 'depends',250, + 'recommends',240, + 'suggests',230, + 'conflicts',220, + 'provides',210, + 'filename',200, + 'size',180, + 'md5sum',170, + 'description',160); + +@ARGV==3 || die; + +$binarydir= shift(@ARGV); +-d $binarydir || die $!; + +$override= shift(@ARGV); +-e $override || die $!; + +$pathprefix= shift(@ARGV); + +open(F,"find $binarydir -name '*.deb' -print |") || die $!; +while (<F>) { + chop($fn=$_); + substr($fn,0,length($binarydir)) eq $binarydir || die $fn; + open(C,"dpkg-deb -I $fn control |") || die "$fn $!"; + $t=''; while (<C>) { $t.=$_; } + $!=0; close(C); $? && die "$fn $? $!"; + undef %tv; + $o= $t; + while ($t =~ s/^\n*(\S+):[ \t]*(.*(\n[ \t].*)*)\n//) { + $k= $1; $v= $2; + $k =~ y/A-Z/a-z/; + if (defined($kmap{$k})) { $k= $kmap{$k}; } + $v =~ s/\s+$//; + $tv{$k}= $v; +#print STDERR "K>$k V>$v<\n"; + } + $t =~ m/^\n*$/ || die "$fn $o / $t ?"; + defined($tv{'package'}) || die "$fn $o ?"; + $p= $tv{'package'}; delete $tv{'package'}; + defined($p1{$p}) && die "$fn $p repeat"; + if (defined($tv{'filename'})) { + print(STDERR " ! Package $p (filename $fn) has Filename field !\n") || die $!; + } + $tv{'filename'}= "$pathprefix$fn"; + open(C,"md5sum <$fn |") || die "$fn $!"; + chop($_=<C>); m/^[0-9a-f]{32}$/ || die "$fn \`$_' $!"; + $!=0; close(C); $? && die "$fn $? $!"; + $tv{'md5sum'}= $_; + defined(@stat= stat($fn)) || die "$fn $!"; + $stat[7] || die "$fn $stat[7]"; + $tv{'size'}= $stat[7]; + if (length($tv{'revision'})) { + $tv{'version'}.= '-'.$tv{'revision'}; + delete $tv{'revision'}; + } + for $k (keys %tv) { + $pv{$p,$k}= $tv{$k}; + $k1{$k}= 1; + $p1{$p}= 1; + } + $_= substr($fn,length($binarydir)); + s#/[^/]+$##; s#^/*##; + $psubdir{$p}= $_; + $pfilename{$p}= $fn; +} +$!=0; close(F); $? && die "$? $!"; + +select(STDERR); $= = 1000; select(STDOUT); + +format STDERR = + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$packages +. + +sub writelist { + $title= shift(@_); + return unless @_; + print(STDERR " $title\n") || die $!; + $packages= join(' ',sort @_); + while (length($packages)) { write(STDERR) || die $!; } + print(STDERR "\n") || die $!; +} + +@inover=(); +@samemaint=(); + +open(O,"<$override") || die $!; +while(<O>) { + s/\s+$//; + ($p,$priority,$section,$maintainer)= split(/\s+/,$_,4); + if (!defined($p1{$p})) { + push(@inover,$p); + next; + } + if (length($maintainer)) { + if ($pv{$p,'maintainer'} eq $maintainer) { + push(@samemaint," $p ($maintainer)\n"); + } else { + $pv{$p,'maintainer'}= $maintainer; + } + } + $pv{$p,'priority'}= $priority; + $pv{$p,'section'}= $section; + if (length($psubdir{$p}) && $section ne $psubdir{$p}) { + print(STDERR " !! Package $p has \`Section: $section',". + " but file is in \`$psubdir{$p}' !!\n") || die $!; + $ouches++; + } + $o1{$p}= 1; +} +close(O); + +if ($ouches) { print(STDERR "\n") || die $!; } + +$k1{'maintainer'}= 1; +$k1{'priority'}= 1; +$k1{'section'}= 1; + +@missingover=(); + +for $p (sort keys %p1) { + if (!defined($o1{$p})) { + push(@missingover,$p); + } + $r= "Package: $p\n"; + for $k (sort { $pri{$b} <=> $pri{$a} } keys %k1) { + next unless length($pv{$p,$k}); + $r.= "$k: $pv{$p,$k}\n"; + } + $r.= "\n"; + $written++; + print(STDOUT $r) || die $!; +} +close(STDOUT) || die $!; + +&writelist("** Packages in archive but missing from override file: **", + @missingover); +&writelist("++ Packages appearing in override file but not in archive: ++", + @inover); +if (@samemaint) { + print(STDERR + " -- Packages specifying same maintainer as override file: --\n", + @samemaint, + "\n") || die $!; +} + +print(STDERR " Wrote $written entries to output Packages file.\n") || die $!; diff --git a/scripts/install-info.8 b/scripts/install-info.8 new file mode 100644 index 000000000..2d8817982 --- /dev/null +++ b/scripts/install-info.8 @@ -0,0 +1,245 @@ +.\" Hey, Emacs! This is an -*- nroff -*- source file. +.\" Install-info and this manpage are Copyright 1994 by Ian Jackson. +.\" +.\" This is free software; see the GNU General Public Licence version 2 +.\" or later for copying conditions. There is NO warranty. +.TH INSTALL-INFO 8 "29th November 1995" "Debian Project" "Debian GNU/Linux" +.SH NAME +install\-info \- create or update entry in Info directory +.SH SYNOPSIS +.B install\-info +[\-\-version] [\-\-help] [\-\-debug] [\-\-maxwidth=nnn] +[\-\-section regexp title] [\-\-infodir=xxx] [\-\-align=nnn] +[\-\-quiet] [\-\-menuentry=xxx] [\-\-description=xxx] [\-\-remove] +[\-\-] filename +.SH DESCRIPTION +.PP +.B install-info +makes, updates or removes entries in the Info directory, the +.B dir +file. When updating or creating entries, if no description is +specified on the command line or in the Info file it attempts to guess +a description from the contents of the file. + +See the description of the +.B \-\-section +option for details of where the entry will be placed and a description +of the expected format of the +.B dir +file. +.SS OPTIONS +.TP +.BI "[\-\-] " filename +Gives the filename of the Info file whose menu entry is to be created, +updated or removed. The basename of this filename is used as the +referent of the menu entry which is created. This file must therefore +exist (or be about to be installed, or have previously existed when +removing an entry) in the same directory as the +.B dir +file (see the +.B \-\-infodir +option). + +If +.I filename +ends in +.B .gz +it is taken to refer to a file compressed with GNU gzip; if it doesn't +exist, but a corresponding +.IB filename .gz +does, the latter is used instead. + +When adding or updating entries the file must exist at the path +specified (possibly with an additional +.B .gz +extension). +.TP +.B \-\-remove +Specifies that the entry for the file +.I filename +is to be removed; by default entries are created or updated. + +If the removal results in a section becoming empty the section heading +(and the spare blank line) will be removed as well, unless this is the +last section in the file or +.B \-\-keep\-old +is specified. See the +.B \-\-section +option for details about the expected format of the +.B dir +file. + +If there are several suitable entries in the +.B dir +file only those in the first matching contiguous group will be removed +and the others silently ignored. + +It is not an error for no suitable entry to be found, though +.B install\-info +will issue a warning unless the +.B \-\-quiet +option was specified. + +When +.B \-\-remove +is specified the +.BR \-\-maxwidth ", " \-\-align " and " \-\-calign +formatting options are silently ignored. +.TP +.BI "\-\-section " "regexp title" +Specifies that, if a new entry is to be made, it should be placed in a +section of the +.B dir +file whose title matches +.IR regexp . +If no such section exists one will be created as the second last +section in the file (see below), with title +.IR title . +A section is a part of the +.B dir +menu delimited by blank lines; the first line is assumed to be the +title. + +If a new entry is to be created +.B install-info +will attempt to insert it within the section according in alphabetic +order; if the entries in the section aren't already sorted the new +location within the section will be unpredictable. The order of +existing entries will not be changed. + +The default is to append new entries to the end of the file. The last +section (even if it only consists of the title line) should always +exist, to ensure that new sections are created in the right place. +The final section should be titled to reflect the fact that Info files +with no more well specified location are appended to it. + +If there is already an entry for the Info file being installed it is +replaced in situ with the new entry. + +If a section is specified when removing an entry the section is +ignored and a warning is issued. +.TP +.BI \-\-infodir= infodir +Specifies that the +.B dir +file is, and the installed copy of the new Info file was, is or will +be located in +.IR infodir . +The default is +.BR /usr/info . +.TP +.BI \-\-align= nnn +Specifies that the first line of the description should be indented at +least +.I nnn +characters; extra spaces will be added as required. If necessary +because of the length of the +.B dir +menu entry details it may be offset more. The default is 27. +.TP +.BI \-\-calign= nnn +Specifies that the second and subsequent lines of the description +should be indented at least +.I nnn +characters. The default is 29. +.TP +.BI \-\-maxwidth= nnn +Specifies that the maximum width for the Info file is +.IR nnn . +This is used when wordwrapping the descriptive text. +The default is 79. +.TP +.B \-\-quiet +Prevents the usual display of the new menu entry just before it is +inserted, and of the messages announcing the replacement and removal +of existing entries and the creation and deletion of sections. +.TP +.B \-\-help +Causes +.B install-info +to display its usage information and exit. +.TP +.B \-\-version +Causes +.B install-info +to display its version and copyright information and exit. +.TP +.BI \-\-description= xxx +Specifies that the description to use after the menu entry in new or +updated entries be +.IR xxx . +The default is to use the the value specified in the Info file itself; +this is found by searching for a section of the form +.br +.B START\-INFO\-DIR\-ENTRY +.br +.B * Auto-PGP: (auto-pgp). PGP under GNU Emacs. +.br +.B END\-INFO\-DIR\-ENTRY + +If the entry found in the Info file itself extends across several +lines, each giving a menu entry, the text found in the file is used +verbatim. In this case the alphabetic ordering scheme is turned off, +and the entries are inserted at the top of section in question. In +this case the +.BR \-\-menuentry ", " \-\-maxwidth ", " \-\-align ", " \-\-calign +.RB " and " \-\-menuentry +options are ignored. + +If there is no +.B dir +entry in the file the program will try to find a paragraph early in +the file starting +.BR "this file documents" . +It will capitalise the first character of the remainder, and use that. + +It is an error for none of these methods to yield a description. + +If a description argument is given when +.B \-\-remove +is specified it is ignored and a warning is issued. +.TP +.BI \-\-menuentry= xxx +Specifies that the entry in the menu should be +.IR xxx . +The default is to use the the value specified in the Info file itself. +If this is not present the basename of the Info file is used +.RB "(any " ".info " "is deleted, and the entry is made mixed case)." +See above for details of the format expected for the menu entry in the +Info file. + +When removing entries the value of the +.B \-\-menuentry +option must match the actual menu entry field in the menu item to be +removed (case not significant). If +.B \-\-menuentry +is omitted no check on the menu entry is done. +.TP +.B \-\-keep\-old +Inhibits the replacement of existing entries and the removal of empty +sections. + +If the file being installed alreay has an entry in the directory the +old entry will be left alone instead of being replaced; the default is +to overwrite any old entry found with the newly generated one. + +If +.BR \-\-remove " is specified " \-\-keep\-old +will prevent the removal of the section heading which would otherwise +happen if the section is made empty by the removal. +.TP +.B \-\-test +Enables test mode, which inhibits the update of the directory file. +.TP +.B \-\-debug +Enables debugging mode, in which the results of some internal +processing steps are shown. +.SH "SEE ALSO" +emacs(1), info(1), gzip(1) +.SH COPYRIGHT +Copyright 1994, Ian Jackson. +.B install\-info +is free software; see the GNU General Public Licence version 2 or +later for copying conditions. There is +.I no +warranty. diff --git a/scripts/install-info.pl b/scripts/install-info.pl new file mode 100755 index 000000000..0455ab1a3 --- /dev/null +++ b/scripts/install-info.pl @@ -0,0 +1,342 @@ +#!/usr/bin/perl -- + +# fixme: --dirfile option +# fixme: sort entries +# fixme: send to FSF ? + +$version= '0.93.42.2'; # This line modified by Makefile +sub version { + print STDERR <<END; +Debian GNU/Linux install-info $version. Copyright (C) 1994,1995 +Ian Jackson. This is free software; see the GNU General Public Licence +version 2 or later for copying conditions. There is NO warranty. +END +} + +sub usage { + print STDERR <<END; +usage: install-info [--version] [--help] [--debug] [--maxwidth=nnn] + [--section regexp title] [--infodir=xxx] [--align=nnn] + [--calign=nnn] [--quiet] [--menuentry=xxx] [--keep-old] + [--description=xxx] [--test] [--remove] [--] filename +END +} + +$infodir='/usr/info'; +$maxwidth=79; +$align=27; +$calign=29; + +undef $menuentry; +undef $quiet; +undef $nowrite; +undef $keepold; +undef $description; +undef $sectionre; +undef $sectiontitle; +$0 =~ m|[^/]+$|; $name= $&; + +while ($ARGV[0] =~ m/^--/) { + $_= shift(@ARGV); + last if $eq eq '--'; + if ($_ eq '--version') { + &version; exit 0; + } elsif ($_ eq '--quiet') { + $quiet=1; + } elsif ($_ eq '--test') { + $nowrite=1; + } elsif ($_ eq '--keep-old') { + $keepold=1; + } elsif ($_ eq '--remove') { + $remove=1; + } elsif ($_ eq '--help') { + &usage; exit 0; + } elsif ($_ eq '--debug') { + open(DEBUG,">&STDERR") || exit 1; + } elsif ($_ eq '--section') { + if (@ARGV < 2) { + print STDERR "$name: --section needs two more args\n"; + &usage; exit 1; + } + $sectionre= shift(@ARGV); + $sectiontitle= shift(@ARGV); + } elsif (m/^--maxwidth=([0-9]+)$/) { + $maxwidth= $1; + } elsif (m/^--align=([0-9]+)$/) { + $align= $1; + } elsif (m/^--calign=([0-9]+)$/) { + $calign= $1; + } elsif (m/^--infodir=/) { + $infodir=$'; + } elsif (m/^--menuentry=/) { + $menuentry=$'; + } elsif (m/^--description=/) { + $description=$'; + } else { + print STDERR "$name: unknown option \`$_'\n"; &usage; exit 1; + } +} + +if (!@ARGV) { &version; print STDERR "\n"; &usage; exit 1; } + +$filename= shift(@ARGV); +if (@ARGV) { print STDERR "$name: too many arguments\n"; &usage; exit 1; } + +if ($remove) { + print STDERR "$name: --section ignored with --remove\n" if length($sectiontitle); + print STDERR "$name: --description ignored with --remove\n" if length($description); +} + +print STDERR "$name: test mode - dir file will not be updated\n" + if $nowrite && !$quiet; + +umask(umask(0777) & ~0444); + +$filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//; +print DEBUG <<END; + infodir=\`$infodir' filename=\`$filename' maxwidth=\`$maxwidth' + menuentry=\`$menuentry' basename=\`$basename' + description=\`$description' remove=$remove +END + +if (!$remove) { + + if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) { + $filename= "gzip -d <$filename.gz |"; $pipeit= 1; + } else { + $filename= "< $filename"; + } + + if (!length($description)) { + + open(IF,"$filename") || die "$name: read $filename: $!\n"; + $asread=''; + while(<IF>) { last if m/^START-INFO-DIR-ENTRY$/; } + while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; } + close(IF); &checkpipe; + if ($asread =~ m/(\* *[^:]+: *\([^\)]+\).*\. *.*\n){2,}/) { + $infoentry= $asread; $multiline= 1; + print DEBUG <<END; + multiline \`$asread' +END + } elsif ($asread =~ m/^\* *([^:]+):( *\([^\)]+\)\.|:)\s*/) { + $menuentry= $1; $description= $'; + print DEBUG <<END; + infile menuentry \`$menuentry' description \`$description' +END + } elsif (length($asread)) { + print STDERR <<END; +$name: warning, ignoring confusing INFO-DIR-ENTRY in file. +END + } + } + + if (length($infoentry)) { + + $infoentry =~ m/\n/; + print "$`\n" unless $quiet; + $infoentry =~ m/^\* *([^:]+): *\(([^\)]+)\)/ || die; # internal error + $sortby= $1; $fileinentry= $2; + + } else { + + if (!length($description)) { + open(IF,"$filename") || die "$name: read $filename: $!\n"; + $asread=''; + while(<IF>) { + if (m/^\s*[Tt]his file documents/) { + $asread=$'; + last; + } + } + if (length($asread)) { + while(<IF>) { last if m/^\s*$/; $asread.= $_; } + $description= $asread; + } + close(IF); &checkpipe; + } + + if (!length($description)) { + print STDERR <<END; +No \`START-INFO-DIR-ENTRY' and no \`This file documents'. +$name: unable to determine description for \`dir' entry - giving up +END + exit 1; + } + + $description =~ s/^\s*(.)//; $_=$1; y/a-z/A-Z/; + $description= $_ . $description; + + if (!length($menuentry)) { + $menuentry= $basename; $menuentry =~ s/\Winfo$//; + $menuentry =~ s/^.//; $_=$&; y/a-z/A-Z/; + $menuentry= $_ . $menuentry; + } + + print DEBUG <<END; + menuentry=\`$menuentry' description=\`$description' +END + + $cprefix= sprintf("* %s: (%s).", $menuentry, $basename); + $align--; $calign--; + $lprefix= length($cprefix); + if ($lprefix < $align) { + $cprefix .= ' ' x ($align - $lprefix); + $lprefix= $align; + } + $prefix= "\n". (' 'x $calign); + $cwidth= $maxwidth+1; + + for $_ (split(/\s+/,$description)) { + $l= length($_); + $cwidth++; $cwidth += $l; + if ($cwidth > $maxwidth) { + $infoentry .= $cprefix; + $cwidth= $lprefix+1+$l; + $cprefix= $prefix; $lprefix= $calign; + } + $infoentry.= ' '; $infoentry .= $_; + } + + $infoentry.= "\n"; + print $infoentry unless $quiet; + $sortby= $menuentry; $sortby =~ y/A-Z/a-z/; + + } +} + +if (!link("$infodir/dir","$infodir/dir.lock")) { + die "$name: failed to lock dir for editing! $!\n". + ($! =~ m/exists/i ? "try deleting $infodir/dir.lock ?\n" : ''); +} + +open(OLD,"$infodir/dir") || &ulquit("$name: open $infodir/dir: $!\n"); +@work= <OLD>; +eof(OLD) || &ulquit("$name: read $infodir/dir: $!\n"); +close(OLD) || &ulquit("$name: close $infodir/dir after read: $!\n"); +while ($work[$#work] !~ m/\S/) { $#work--; } + +if (!$remove) { + + for ($i=0; $i<=$#work; $i++) { + next unless $work[$i] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/; + last if $1 eq $basename || $1 eq "$basename.info"; + } + for ($j=$i; $j<=$#work+1; $j++) { + next if $work[$j] =~ m/^\s+\S/; + last unless $work[$j] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/; + last unless $1 eq $basename || $1 eq "$basename.info"; + } + + if ($i < $j) { + if ($keepold) { + print "$name: existing entry for \`$basename' not replaced\n" unless $quiet; + $nowrite=1; + } else { + print "$name: replacing existing dir entry for \`$basename'\n" unless $quiet; + } + $mss= $i; + @work= (@work[0..$i-1], @work[$j..$#work]); + } elsif (length($sectionre)) { + for ($i=0; $i<=$#work && $work[$i] !~ m/^\* *menu/i; $i++) { } + $mss= -1; + for (; $i<=$#work; $i++) { + $_= $work[$i]; + next if m/^\*/; + next unless m/$sectionre/io; + $mss= $i+1; last; + } + if ($mss < 0) { + print "$name: creating new section \`$sectiontitle'\n" unless $quiet; + for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { } + $i >= 0 || &ulquit("$name: nowhere to create new section - giving up\n"); + @work= (@work[0..$i], "$sectiontitle\n", "\n", @work[$i+1..$#work]); + $mss= $i+1; + } + while ($mss <= $#work) { + $work[$mss] =~ m/\S/ || last; + $work[$mss] =~ m/^\* *([^:]+):/ || ($mss++, next); + last if $multiline; + $_=$1; y/A-Z/a-z/; + last if $_ gt $sortby; + $mss++; + } + } else { + print "$name: no section specified for new entry, placing at end\n" + unless $quiet; + $mss= $#work+1; + } + + @work= (@work[0..$mss-1], $infoentry, @work[$mss..$#work]); + +} else { + + for ($i=0; $i<=$#work; $i++) { + next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/; + $tme= $1; $tfile= $2; $match= $&; + next unless $tfile eq $basename; + last if !length($menuentry); + $tme =~ y/A-Z/a-z/; + last if $tme eq $menuentry; + } + for ($j=$i; $j<=$#work+1; $j++) { + next if $work[$j] =~ m/^\s+\S/; + last unless $work[$j] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/; + $tme= $1; $tfile= $2; + last unless $tfile eq $basename; + next if !length($menuentry); + $tme =~ y/A-Z/a-z/; + last unless $tme eq $menuentry; + } + print DEBUG <<END; + i=$i \$work[\$i]=\`$work[$i]' j=$j \$work[\$j]=\`$work[$j]' +END + + if ($i < $j) { + print "$name: deleting entry \`$match ...'\n" unless $quiet; + $_= $work[$i-1]; + unless (m/^\s/ || m/^\*/ || m/^$/ || + $j > $#work || $work[$j] !~ m/^\s*$/) { + s/:?\s+$//; + if ($keepold) { + print "$name: empty section \`$_' not removed\n" unless $quiet; + } else { + $i--; $j++; + print "$name: deleting empty section \`$_'\n" unless $quiet; + } + } + @work= (@work[0..$i-1], @work[$j..$#work]); + } else { + print "$name: no entry for file \`$basename'". + (length($menuentry) ? " and menu entry \`$menuentry'": ''). + ".\n" + unless $quiet; + } +} + +if (!$nowrite) { + open(NEW,"> $infodir/dir.new") || &ulquit("$name: create $infodir/dir.new: $!\n"); + print(NEW @work) || &ulquit("$name: write $infodir/dir.new: $!\n"); + close(NEW) || &ulquit("$name: close $infodir/dir.new: $!\n"); + + unlink("$infodir/dir.old"); + link("$infodir/dir","$infodir/dir.old") || + &ulquit("$name: cannot backup old $infodir/dir, giving up: $!\n"); + rename("$infodir/dir.new","$infodir/dir") || + &ulquit("$name: install new $infodir/dir: $!\n"); +} + +unlink("$infodir/dir.lock") || die "$name: unlock $infodir/dir: $!\n"; + +sub ulquit { + unlink("$infodir/dir.lock") || + warn "$name: warning - unable to unlock $infodir/dir: $!\n"; + die $_[0]; +} + +sub checkpipe { + return if !$pipeit || !$? || $?==0x8D00; + die "$name: read $filename: $?\n"; +} + +exit 0; diff --git a/scripts/lib.pl b/scripts/lib.pl new file mode 100644 index 000000000..ba9c12765 --- /dev/null +++ b/scripts/lib.pl @@ -0,0 +1,565 @@ +# -*- perl -*- +# +# dpkg library: Debian GNU/Linux package maintenance utility, +# useful library functions. +# +# Copyright (C) 1994 Matt Welsh <mdw@sunsite.unc.edu> +# Copyright (C) 1994 Carl Streeter <streeter@cae.wisc.edu> +# Copyright (C) 1994 Ian Murdock <imurdock@debian.org> +# Copyright (C) 1994 Ian Jackson <iwj10@cus.cam.ac.uk> +# +# dpkg is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2, +# or (at your option) any later version. +# +# dpkg is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public +# License along with dpkg; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# /var/lib/dpkg/ +---- status +# |---- updates/ +---- <id> +# | |---- tmp.i +# | \---- <id>.new +# |---- available +# |---- lock +# |---- info/ |---- <package>.{post,pre}{inst,rm} +# |---- tmp.$$ +# \---- tmp.ci/ +---- control +# |---- conffiles +# |---- {post,pre}{inst,rm} +# |---- list +# \---- conffiles + +$backend = "dpkg-deb"; +$fpextract = "dpkg-deb"; +$md5sum = "md5sum"; +$dselect = "dselect"; +$dpkg = "dpkg"; + +$status_mergeevery = 20; +$tmp = "/tmp"; +$visiblecontroldir = "DEBIAN"; + +sub setadmindir { + $dd = $_[0]; + $statusdb = "$dd/status"; + $updatesdir = "$dd/updates"; + $availabledb = "$dd/available"; + $scriptsdir = "$dd/info"; + $listsdir = "$dd/info"; + $lockfile = "$dd/lock"; + $lockmine = "$dd/tmp.$$"; + $controli = "$dd/tmp.ci"; + $importantspace = "$updatesdir/tmp.i"; +} +$orgadmindir= "/var/lib/dpkg"; +&setadmindir($orgadmindir); + +@nokeepfields= ('package','version','package_revision', + 'depends','recommended','optional','conflicts','part'); +# Don't keep these fields in the Available database if a new record is +# merged which is missing values for any of them. + +$packagere = '\w[-_a-zA-Z0-9+.@:=%]+'; +$packageversionre= $packagere.'(\s*\([^()]+\))?'; +$singledependencyre= "$packageversionre(\\s*\\|\\s*$packageversionre)*"; + +# Abbreviations for dpkg-deb options common to dpkg & dpkg-deb. +%debabbrevact= ('b','build', 'c','contents', 'e','control', 'i','info', + 'f','field', 'x','extract', 'X','vextract'); + +@keysortorder= ('package', 'status', 'version', 'package_revision', + 'maintainer', 'description', + 'depends', 'recommended', 'optional', 'conflicts', + 'list', 'conffiles'); + +#*** replacements for things in headers ***# + +#require 'sys/errno.ph'; +sub ENOENT { 2; } # No such file or directory +sub EEXIST { 17; } # File exists +sub EISDIR { 21; } # Is a directory +sub ENOTEMPTY { 39; } # Directory not empty + +#require 'sys/stat.ph'; +sub S_IFMT { 00170000; } +sub S_IFREG { 0100000; } +sub S_IFLNK { 0120000; } +sub S_ISREG { ($_[0] & &S_IFMT) == &S_IFREG; } +sub S_ISLNK { ($_[0] & &S_IFMT) == &S_IFLNK; } + +#require 'sys/wait.ph'; +sub WIFEXITED { ($_[0] & 0x0ff) == 0; } +sub WIFSTOPPED { ($_[0] & 0x0ff) == 0x07f; } +sub WIFSIGNALED { !&WIFEXITED && !&WIFSTOPPED; } +sub WCOREDUMP { ($_[0] & 0x080) != 0; } +sub WEXITSTATUS { ($_[0] & 0x0ff00) >> 8; } +sub WSTOPSIG { ($_[0] & 0x0ff00) >> 8; } +sub WTERMSIG { $_[0] & 0x07f; } + +#require 'sys/signal.ph'; +sub SIGPIPE { 13; } + +#require 'sys/syscall.ph'; +sub SYS_lseek { 19; } + + +#*** /var/lib/dpkg database management - `exported' routines ***# + +sub database_start { + # Lock the package management databases, amalgamate any + # changes files, and leave the results in: + # From /var/lib/dpkg/status: + # %st_pk2v{ package_name, field_name } = field_value + # %st_p21{ package_name } = 1 + # From /var/lib/dpkg/available: + # %av_pk2v{ package_name, field_name } = field_value + # %av_p21{ package_name } = 1 + # From both: + # %all_k21{ field_name } = 1 + &lock_database; + &read_status_mainfile; + &read_status_extrafiles; + &write_status_mainfile; + &delete_status_extrafiles; + &read_available_file; + &prepare_important_database; + &invent_status_availableonly_packages; +} + +sub database_finish { + # Tidy up and unlock the package management databases. + &release_important_database; + &write_available_file; + &write_status_mainfile; + &delete_status_extrafiles; + &unlock_database; +} + +sub amended_status { + # Record amended status of package (in an `extra' file). + local (@packages) = @_; + local ($p); + &debug("amended @packages"); + for $p (@packages) { + $st_pk2v{$p,'status'}= "$st_p2w{$p} $st_p2h{$p} $st_p2s{$p}"; + $st_p21{$p}= 1; + } + $all_k21{'status'}= 1; + local ($ef) = sprintf("%03d",$next_extrafile++); + &write_database_file("$updatesdir/$ef",*st_pk2v,*st_p21,1,@packages); + push(@status_extrafiles_done,$ef); &sync; + if ($next_extrafile >= $status_mergeevery) { + &write_status_mainfile; + &delete_status_extrafiles; + } + $status_modified= 1; + for $p (@packages) { delete $st_pk2v{$p,'status'}; } + &prepare_important_database; +} + +sub note_amended_status { + # Note the fact that the status has been modified, but don't + # commit yet. + $status_modified= 1; +} + +sub amended_available { + # Record amended available information (in core for the moment - + # noncritical, so we defer writing it out). + $available_modified++; + &invent_status_availableonly_packages(@_); +} + +#*** internal routines ***# + +sub invent_status_availableonly_packages { + local ($p); + for $p (@_ ? @_ : keys %av_p21) { + next if defined($st_p2w{$p}); + $st_p2w{$p}= 'unknown'; + $st_p2h{$p}= 'ok'; + $st_p2s{$p}= 'not-installed'; + } +} + +sub read_status_mainfile { + local ($p, @p); + &read_status_database_file($statusdb); +} + +sub read_status_extrafiles { + local ($fn); + opendir(UPD,$updatesdir) || &bombout("cannot opendir updates $updatesdir: $!"); + for $_ (sort readdir(UPD)) { + next if $_ eq '.' || $_ eq '..'; + if (m/\.new$/ || m/\.old$/ || $_ eq 'tmp.i') { + unlink("$updatesdir/$_") || + &bombout("cannot unlink old update temp file $updatesdir/$_: $!"); + } elsif (m/^\d+$/) { + $fn= $_; + &read_status_database_file("$updatesdir/$fn"); + $status_modified= 1; push(@status_extrafiles_done, $fn); + } else { + warn("$name: ignoring unexpected file in $updatesdir named \`$_'\n"); + } + } + closedir(UPD); +} + +sub read_status_database_file { + local ($filename) = @_; + @p= &read_database_file($filename,*st_pk2v,*st_p21); + for $p (@p) { + if (defined($st_pk2v{$p,'status'})) { + $v= $st_pk2v{$p,'status'}; + $v =~ y/A-Z/a-z/; + $v =~ + m/^(unknown|install|deinstall|purge)\s+(ok|hold)\s+(not-installed|unpacked|postinst-failed|installed|removal-failed|config-files)$/ + || &bombout("package \`$p' has bad status in $statusdb (\`$v')"); + $st_p2w{$p}= $1; + $st_p2h{$p}= $2; + $st_p2s{$p}= $3; + } + delete($st_pk2v{$p,'status'}); + } + $status_modified= 0; @status_extrafiles_done= (); +} + +sub write_status_mainfile { + return unless $status_modified; + local ($p); + for $p (keys %st_p21) { + $st_pk2v{$p,'status'}= "$st_p2w{$p} $st_p2h{$p} $st_p2s{$p}"; + } + $all_k21{'status'}= 1; + unlink("$statusdb.old") || $!==&ENOENT || + &bombout("unable to remove $statusdb.old: $!"); + link("$statusdb","$statusdb.old") || + &bombout("unable to back up $statusdb: $!"); + &write_database_file($statusdb,*st_pk2v,*st_p21,0); + $status_modified= 0; + &sync; + for $p (keys %st_p21) { delete $st_pk2v{$p,'status'}; } +} + +sub delete_status_extrafiles { +#print STDERR "delete @status_extrafiles_done> "; <STDIN>; + for $_ (@status_extrafiles_done) { + unlink("$updatesdir/$_") || + &bombout("cannot remove already-done update file $updatesdir/$_: $!"); + } + $next_extrafile= 0; + @status_extrafiles_done= (); +} + +sub read_available_file { + &read_database_file($availabledb,*av_pk2v,*av_p21); + $available_modified= 0; +} + +sub write_available_file { + return unless $available_modified; + &write_database_file($availabledb,*av_pk2v,*av_p21,0); + $available_modified= 0; +} + +#*** bottom level of read routines ***# + +sub read_database_file { + local ($filename, *xx_pk2v, *xx_p21) = @_; + local ($quick,$cf,@cf,%cf_k2v,@cwarnings,@cerrors,$p,@p)= 1; + &debug("reading database file $filename"); + open(DB,"<$filename") || &bombout("unable to open $filename for reading: $!"); + $/=""; + @p=(); + while (defined($cf=<DB>)) { + chop($cf); +# $cf =~ s/\n+$/\n/; + $p= &parse_control_entry; +# if (@cwarnings) { +# warn("$name: warning, packaging database file $filename\n". +# " contains oddities in entry for package \`$p':\n ". +# join(";\n ",@cwarnings). +# ".\n This is probably a symptom of a bug.\n"); +# } + if (@cerrors) { + &bombout("packaging database corruption - please report:\n". + " file $filename has error(s) in entry for \`$p':\n ". + join(";\n ",@cerrors). "."); + } + $xx_p21{$p}= 1; + for $k (keys %all_k21) { $xx_pk2v{$p,$k}= $cf_k2v{$k}; } + push(@p,$p); + } + &debug("database file $filename read"); + $/="\n"; close(DB); + return @p; +} + +sub parse_control_entry { + # Expects $cf to be a sequence of lines, + # representing exactly one package's information. + # Results are put in cf_k2v. + # @warnings and @errors are made to contain warning and error + # messages, respectively. + local ($ln,$k,$v,$p,$l); + @cwarnings= @cerrors= (); + + undef %cf_k2v; +# &debug(">>>$cf<<<#\n"); + if (!$quick) { + if ($cf =~ s/\n\n+/\n/g) { push(@cwarnings, "blank line(s) found and ignored"); } + if ($cf =~ s/^\n+//) { push(@cwarnings, "blank line(s) at start ignored"); } + if ($cf !~ m/\n$/) { + $cf.= "\n"; push(@cwarnings, "missing newline after last line assumed"); + } + if ($cf =~ s/\0//g) { + push(@cwarnings, "nul characters discarded"); + } + } + $cf =~ s/\n([ \t])/\0$1/g; # join lines +# &debug(">>>$cf<<<*\n"); + $ln = 0; + for $_ (split(/\n/,$cf)) { + $ln++; s/\s+$//; + next if m/^#/; + m/^(\S+):[ \t]*/ || (push(@cerrors, "garbage at line $ln, \`$_'"), next); + $k= $1; $v= $'; $k =~ y/A-Z/a-z/; $k='package_revision' if $k eq 'revision'; +# &debug("key=\`$k' value=\`$v' line=\`$_'\n"); + $ln += ($v =~ s/\0/\n/g); + $cf_k2v{$k}= $v; + $all_k21{$k}= 1; +# while ($cf =~ s/^(\S+):[ \t]*(.*)\n//) { + } + return unless keys %cf_k2v; + $p= $cf_k2v{'package'}; delete $cf_k2v{'package'}; delete $all_k21{'package'}; + $cf_k2v{'class'} =~ y/A-Z/a-z/ if defined($cf_k2v{'class'}); + $cf_k2v{'section'} =~ y/A-Z/a-z/ if defined($cf_k2v{'section'}); +# length($cf) && +# push(@cerrors, "garbage at line $ln, \`".($cf =~ m/\n/ ? $` : $cf)."'"); + if (!$quick) { + defined($p) || push(@cerrors, "no \`package' line"); + $p =~ m/^$packagere$/o || &bad_control_field('package'); + defined($cf_k2v{'version'}) || push(@cerrors, "no Version field"); + for $f ('depends','recommended','optional','conflicts') { + next unless defined($cf_k2v{$f}) && length($cf_k2v{$f}); + $cf_k2v{$f} =~ m/^$singledependencyre(\s*,\s*$singledependencyre)*$/o + || &bad_control_field("$f"); + } + } + return $p; +} + +sub bad_control_field { + push(@cerrors, "bad \`$_[0]' line, contains \`$cf_k2v{$_[0]}'"); +} + +#*** bottom level of database writing code ***# + +sub write_database_file { + local ($filename, *xx_pk2v, *xx_p21, $important, @packages) = @_; + local ($p,$tl,$k,$v); + if (!@packages) { @packages= keys(%xx_p21); } + + &debug("called write_database_file $filename, important=$important, for @packages"); + if (!$important) { + open(DB,">$filename.new") || &bombout("unable to create $filename.new: $!"); + } + $tl= 0; + for $p (@packages) { + &write_database_string("\n") if $tl; + &write_database_string("Package: $p\n"); + for $k (keys %all_k21) { + next unless defined($xx_pk2v{$p,$k}); + $v= $xx_pk2v{$p,$k}; + $v =~ s/\n(\S)/\n $1/g; + &write_database_string("$k: $v\n"); + } + } + if ($important) { + if (!truncate(IMP,$tl)) { + if (print(IMP "#")) { + warn("$name: warning - unable to truncate $importantspace: $!;". + "\n commenting the rest out instead seems to have worked.\n"); + } else { + &database_corrupted("unable to truncate $importantspace: $!"); + } + } + close(IMP) || &database_corrupted("unable to close $importantspace: $!"); + rename($importantspace,$filename) || + &database_corrupted("unable to install $importantspace as $filename: $!"); + } else { + close(DB) || &bombout("unable to close $filename.new: $!"); + rename("$filename.new",$filename) || + &bombout("unable to install $filename.new as $filename: $!"); + } +} + +sub write_database_string { + $tl += length($_[0]); + if ($important) { + print(IMP $_[0]) || + &database_corrupted("failed write to update file $importantspace: $!"); + } else { + print(DB $_[0]) || + &bombout("failed to write to $filename.new: $!"); + } +} + +sub database_corrupted { + &debug("corruptingstatus @_"); + print STDERR "$name - really horrible error:\n @_\n". + "Package manager status data is now out of step with installed system.\n". + "(Last action has not been recorded. Please try re-installing \`@packages'\n". + "to ensure system consistency, or seek assistance from an expert if\n". + "problems persist.)\n"; + &cleanup; exit(2); +} + +sub prepare_important_database { + open(IMP,"+>$importantspace") || &bombout("unable to create $importantspace: $!"); + select((select(IMP),$|=1)[0]); + print(IMP "#padding\n"x512) || &bombout("unable to pad $importantspace: $!"); + seek(IMP,0,0) || &bombout("unable to seek (rewind) $importantspace: $!"); + &debug("important database prepared"); +} + +sub release_important_database { + close(IMP); + unlink($importantspace) || &bombout("unable to delete $importantspace: $!"); + &debug("important database released"); +} + +#*** database lock management ***# + +sub lock_database { + # Lock the package management databases. Stale locks will + # be broken, but there is no concurrency checking on the lock- + # breaking code. + push(@cleanups,'unlink($lockmine)'); + open(PID,">$lockmine") || &bombout("failed to create new pid file $lockmine: $!"); + printf(PID "%010d\n",$$) || &bombout("failed to add pid to $lockmine: $!"); + close(PID) || &bombout("failed to close new pid file $lockmine: $!"); + unless (link($lockmine,$lockfile)) { + $! == &EEXIST || &bombout("failed to create lock on packages database: $!"); + if (open(PID,"<$lockfile")) { + undef $/; $opid= <PID>; $/="\n"; + $opid =~ m/^\d{10}\n$/ || &lockfailed(" (pid missing)"); + close(PID); + -d '/proc/self' || + &bombout("/proc/self not found ($!) - /proc not mounted ?"); + -d sprintf("/proc/%d",$opid) && &lockfailed(" (in use by pid $opid)"); + if (open(PID,"<$lockfile")) { + $opid eq <PID> || &lockfailed(' (pid changed)'); + close(PID); + unlink($lockfile) || + &bombout("failed to break stale lock on database: $!"); + print STDERR + "$name: stale lock found on packages database, lock forced\n"; + } else { + $!==&ENOENT || + &bombout("failed to confirm who owns lock on database: $!"); + } + } else { + $!==&ENOENT || &bombout("failed to determine who owns lock on database: $!"); + } + link($lockmine,$lockfile) || + &bombout("failed to create lock on packages database: $!"); + } + push(@cleanups, 'unlink($lockfile) || + warn("$name: failed to unlock packages database: $!\n")'); + unlink($lockmine); +} + +sub unlock_database { + unlink($lockfile) || &bombout("failed to unlock packages database: $!"); + pop(@cleanups); +} + +#*** error handling ***# + +sub lockfailed { &bombout("unable to lock packages database@_"); } +sub bombout { print STDERR "$name - critical error: @_\n"; &cleanup; exit(2); } +sub badusage { print STDERR "$name: @_\n\n"; &usage; &cleanup; exit(3); } + +sub outerr { + &bombout("failed write to stdout: $!"); +} + +sub cleanup { + while (@cleanups) { + eval(pop(@cleanups)); + $@ && print STDERR "error while cleaning up: $@"; + } +} + +sub debug { + return unless $debug; + print "D: @_\n"; +} + +sub ecode { + local ($w,$s) = ($?,$!); + &debug("ecode $w syserr $s"); + return +# (($w & 0x0ffff) == 0x0ff00 ? "problems running program - exit code -1" : +# ($w & 0x0ff) == 0 ? "exit status ".(($w & 0x0ff00) >> 8) : +# ($w & 0x0ff) == 0x07f ? "stopped by signal ".(($w & 0x0ff00) >> 8) : +# "killed by signal ".($w & 0x07f).($w & 0x080 ? " (core dumped)" : '')). + (&WIFEXITED($w) ? "exit status ".&WEXITSTATUS($w) : + &WIFSIGNALED($w) ? "killed by signal ".&WTERMSIG($w). + (&WCOREDUMP($w) ? " (core dumped)" : ""): + &WIFSTOPPED($w) ? "stopped due to signal ".&WSTOPSIG($w) : + "unknown status $w"). + ($s ? ", system error $s" : ''); +} + +#*** miscellaneous helpful routines ***# + +sub readall { + local ($fh) = @_; + local ($r,$n,$this) = ''; + for (;;) { + defined($n=read($fh,$this,4096)) || return undef; + $n || last; + $r.= $this; + } + return $r; +} + +#sub debug_compare_verrevs { +# local (@i)= @_; +# local ($i)= &x_compare_verrevs(@i); +# &debug("compare_verrevs >@i< = >$i<"); +# return $i; +#} + +sub compare_verrevs { + local ($av,$ar,$bv,$br,$c) = @_; + $c = &compare_vnumbers($av,$bv); return $c if $c; + return &compare_vnumbers($ar,$br); +} + +sub compare_vnumbers { + local ($a, $b) = @_; + do { + $a =~ s/^\D*//; $ad= $&; $ad =~ s/\W/ /g; + $b =~ s/^\D*//; $bd= $&; $bd =~ s/\W/ /g; + $cm = $ad cmp $bd; return $cm if $cm; + $a =~ s/^\d*//; $ad= $&; + $b =~ s/^\d*//; $bd= $&; + $cm = $ad <=> $bd; return $cm if $cm; + } while (length ($a) && length ($b)); + return length ($a) cmp length ($b); +} + +sub sync { + system('sync'); +} diff --git a/scripts/perl-dpkg.pl b/scripts/perl-dpkg.pl new file mode 100755 index 000000000..ba70fc5f5 --- /dev/null +++ b/scripts/perl-dpkg.pl @@ -0,0 +1,1482 @@ +#!/usr/bin/perl -- +# +# dpkg: Debian GNU/Linux package maintenance utility +# +# Copyright (C) 1994 Matt Welsh <mdw@sunsite.unc.edu> +# Copyright (C) 1994 Carl Streeter <streeter@cae.wisc.edu> +# Copyright (C) 1994 Ian Murdock <imurdock@debian.org> +# Copyright (C) 1994 Ian Jackson <iwj10@cus.cam.ac.uk> +# +# dpkg is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2, +# or (at your option) any later version. +# +# dpkg is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public +# License along with dpkg; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# + +$version= '0.93.15'; # This line modified by Makefile + +sub version { + print STDERR <<END; +Debian GNU/Linux \`dpkg\' package handling tool version $version. +Copyright (C)1994 Matt Welsh, Carl Streeter, Ian Murdock, Ian Jackson. +This is free software; see the GNU General Public Licence version 2 +or later for copying conditions. There is NO warranty. +END +} + +sub usage { + print STDERR <<END; +Usage: dpkg -i|--install <opts> <.deb file name> ... | -a|--auto <dir> ... + dpkg --unpack <opts> <.deb file name> ... | -a|--auto <dir> ... + dpkg -A|--avail <opts> <.deb file name> ... | -a|--auto <dir> ... + dpkg --configure <opts> <package name> ... | -a|--auto + dpkg -r|--remove <opts> <package name> ... | -a|--auto + dpkg -l|--list <status select> [<regexp> ...] + dpkg -s|--status <status select> [<package-name> ...] + dpkg -S|--search <glob pattern> ... + dpkg -b|--build|-c|--contents|-e|--control|--info|-f|--field| + -x|--extract|-X|--vextract ... (see dpkg-deb --help) +Options: --purge --control-quiet --control-verbose --version --help + -R|--root=<directory> --admindir=<directory> --instdir=<directory> + --no-keep-old-conf --no-keep-new-conf -N|--no-also-select + --ignore-depends=<package name>,... + --conf-(same|diff|all)-(new|old|promptnew|promptold) + --force-<thing>,<thing>,... --no-force-...|--refuse-... +Status selections: --isok-[o][h] (OK, Hold; alternatives are y, n) + --want-[u][i][d][p] (Unknown, Install, Deinstall, Purge) + --stat-[nupircNO] (Not, Unpacked, Postinst-failed, Installed, Removal-failed, + Config-files, Not/Config-files, Not/Config-files/Installed) +Force things: conflicts, depends, downgrade, depends-version, prermfail, + configure-any, hold, extractfail + (default is --no-force everything, except --force-downgrade) +Use \`$dselect\' for user-friendly package management. +END +} + +$instroot= ''; +$controlwarn = 1; +$estatus = 0; +$filename_pattern = "*.deb"; +%force= ( 'conflicts',0, 'depends',0, 'depends-version',0, 'downgrade',1, + 'prermfail',0, 'postrmfail',0, 'hold',0, 'configure-any',0, + 'extractfail',0 ); + +%selectmap_h= ('o','ok', 'h','hold', 'y','ok', 'n','hold'); +%selectmap_w= ('u', 'unknown', 'i', 'install', 'd', 'deinstall', 'p', 'purge'); +%selectmap_s= ('n', 'not-installed', + 'u', 'unpacked', + 'p', 'postinst-failed', + 'i', 'installed', + 'r', 'removal-failed', + 'c', 'config-files', + 'n', 'not-installed,config-files', + 'o', 'not-installed,config-files,installed'); +%selectthings= ('isok','h', 'want','w', 'stat','s'); + +require 'lib.pl'; # This line modified by Makefile +$0 =~ m|[^/]+$|; $name = $dpkg; +$|=1; +umask(022); + +$action= 'none'; + +%myabbrevact= ('i','install', 'r','remove', 'A','avail', + 'S','search', 'l','list', 's','status'); + +# $conf...[0] corresponds to `same', 1 to diff +$confusenew[0]= 0; $confprompt[0]= 0; +$confusenew[1]= 1; $confprompt[1]= 1; +# Ie, default is to prompt only when hashes differ, +# and to use new when hashes differ + +while ($ARGV[0] =~ m/^-/) { + $_= shift(@ARGV); + $noptsdone++; + if (m/^--$/) { + $noptsdone--; last; + } elsif (m/^--(install|remove|unpack|configure|avail|list|status)$/) { + &setaction($1); + } elsif (m/^--(build|contents|control|info|field|extract|vextract)$/) { + $noptsdone--; &backend($1); + } elsif (m/^--ignore-depends=($packagere(,$packagere)*)$/o) { + grep($ignore_depends{$_}=1, split(/,/,$1)); + } elsif (m/^--(force|no-force|refuse)-/) { + $fvalue= ($1 eq 'force'); + for $fv (split(/,/,$')) { + defined($force{$fv}) || &badusage("unknown --force option \`$fv'"); + $force{$fv}= $fvalue; + } + } elsif (m/^--conf-(same|diff|all)-(new|old|promptnew|promptold)$/) { + $new= $2 eq 'new' || $2 eq 'promptnew'; + $prompt= $2 eq 'promptnew' || $2 eq 'promptold'; + if ($1 ne 'same') { $confusenew[1]= $new; $confprompt[1]= $prompt; } + if ($1 ne 'diff') { $confusenew[0]= $new; $confprompt[0]= $prompt; } + } elsif (m/^--(\w+)-(\w+)$/ && defined($selectthings{$1})) { + $thisname= $1; + $thisthing= $selectthings{$thisname}; + $_=$2; + eval '%thismap= %selectmap_'.$thisthing; + while (s/^.//) { + if (!defined($thismap{$&})) { + &badusage("unknown status letter $& for status field $thisname"); + } + $thiscodes= $thismap{$&}; + $selectdo.= "undef \$select_$thisthing;"; + for $v (split(m/,/, $thiscodes)) { + $selectdo .= "\$select_$thisthing{'$v'}=1;"; + } + } + } elsif (m/^--root=/) { + $instroot=$'; &setadmindir("$instroot/$orgadmindir"); + } elsif (m/^--admindir=/) { + &setadmindir("$'"); + } elsif (m/^--instdir=/) { + $instroot=$'; + } elsif (m/^--auto$/) { + $auto= 1; + } elsif (m/^--purge$/) { + $purge= 1; + } elsif (m/^--skip-same-version$/) { + print STDERR + "Warning: dpkg --skip-same-version not implemented, will process\n". + " process even packages the same version of which is installed.\n"; + } elsif (m/^--no-also-select$/) { + $noalsoselect= 1; + } elsif (m/^--control-verbose$/) { + $controlwarn= 1; + } elsif (m/^--control-quiet$/) { + $controlwarn= 0; + } elsif (m/^--no-keep-old-conf$/) { + $nokeepold= 1; + } elsif (m/^--no-keep-new-conf$/) { + $nokeepnew= 1; + } elsif (m/^--succinct-prompts$/) { + $succinct= 1; + } elsif (m/^--debug$/) { + $debug= 1; + } elsif (m/^--help$/) { + &usage; exit(0); + } elsif (m/^--version$/) { + &version; exit(0); + } elsif (m/^--/) { + &badusage("unknown option \`$_'"); + } else { + s/^-//; $noptsdone--; + while (s/^.//) { + $noptsdone++; + if (defined($myabbrevact{$&})) { + &setaction($myabbrevact{$&}); + } elsif (defined($debabbrevact{$&})) { + $noptsdone--; &backend($debabbrevact{$&}); + } elsif ($& eq 'a') { + $auto= 1; + } elsif ($& eq 'D') { + $debug= 1; + } elsif ($& eq 'N') { + $noautoselect= 1; + } elsif ($& eq 'R') { + s/^=// || &badusage("missing value for -R=<dir> option"); + $instroot= $_; &setadmindir("$instroot/$orgadmindir"); $_=''; + } else { + &badusage("unknown option \`-$&'"); + } + } + } +} + +$action eq 'none' && &badusage("an action must be specified"); + +&debug("arguments parsed"); + +#*** list, status or search - the nonactive operations ***# + +if ($action eq 'list' || $action eq 'status') { + &database_start; + if ($action eq 'list' || !@ARGV) { + &selectall(*selectmap_h,*select_h); + &selectall(*selectmap_w,*select_w); + &selectall(*selectmap_s,*select_s); + if (@ARGV) { $select_s{'not-installed'}=0; } + } + $ecode= 0; + if ($action eq 'status') { + for ($i=0;$i<=$#keysortorder;$i++) { + $keysortorder{$keysortorder[$i]}= sprintf("%6d ",$i); +# &debug("set $i: $keysortorder[$i], sortorder ". +# "\`$keysortorder{$keysortorder[$i]}'"); + } + @ARGV= &applyselcrit(sort keys %st_p21) unless @ARGV; + for $p (@ARGV) { + if (!$st_p21{$p}) { + print(STDERR "$name: no information available about package $p\n") + || &bombout("writing to stderr: $!"); + $ecode= 1; + } + print("Package: $p\n", + "Status: $st_p2w{$p} $st_p2h{$p} $st_p2s{$p}\n") || &outerr; + for $k (sort { $keysortorder{$a}.$a cmp $keysortorder{$b}.$b; } + keys %all_k21) { +# &debug("field $k, sortorder \`$keysortorder{$k}'"); + next unless defined($st_pk2v{$p,$k}); + $v= $st_pk2v{$p,$k}; next unless length($v); + if ($k eq 'conffiles' || $k eq 'list') { + $v= sprintf("(%d files, not listed)", + scalar(grep(m/\S/, split(/\n/,$v)))); + } + print("$k: $v\n") || &outerr; + } + if (defined($av_p21{$p})) { + print("\n\`Available' version of package $p, where different:\n") + || &outerr; + for $k (keys %all_k21) { + next unless defined($av_pk2v{$p,$k}); + $v= $st_pk2v{$p,$k}; next unless length($v); + $u= $st_pk2v{$p,$k}; next if $u eq $v; + print("$k: $v\n") || &outerr; + } + print("\n") || &outerr; + } + } + } else { # $action eq 'list' + $listhead=0; + if (@ARGV) { + for $r (@ARGV) { + &listinfo(&applyselcrit(sort grep(m/$r/,keys %st_p21))); + } + } else { + undef $r; + &listinfo(&applyselcrit(sort keys %st_p21)); + } + } + &database_finish; + exit($ecode); +} + +sub listinfo { + if (!@_) { + print(STDERR + defined($r) ? + "No selected packages found matching regexp \`$r'.\n" : + "No packages matched selection criteria.\n") || + &bombout("writing to stderr: $!"); + return; + } + + if (!$listhead) { + print <<END +Err? Name Version Rev Description +| Status=Not/Unpacked/Postinst-failed/Installed/Removal-failed/Config-files +|/ Desired=Unknown/Install/Deinstall/Purge +||/ | | | | ++++-============-==========-===-=============================================== +END + || &outerr; + $listhead= 1; + } + for $p (@_) { + $des= $st_pk2v{$p,'description'}; + $des= $` if $des =~ m/\n/; + printf("%s%.1s%.1s %-12.12s %-10.10s %-3.3s %-47.47s\n", + $st_p2h{$p} eq 'hold' ? 'x' : ' ', $st_p2s{$p}, $st_p2w{$p}, + $p, $st_pk2v{$p,'version'}, $st_pk2v{$p,'package_revision'}, + $des); + } +} + +sub applyselcrit { + &debug("sel from @_"); + for $f (@_) { &debug("$f :$st_p2s{$f},$select_s{$st_p2s{$f}}:$st_p2w{$f},$select_w{$st_p2w{$f}}:$st_p2h{$f},$select_h{$st_p2h{$f}}:"); } + @ascr= grep($select_s{$st_p2s{$_}} && + $select_w{$st_p2w{$_}} && + $select_h{$st_p2h{$_}}, + @_); + &debug("sel gave @ascr"); + @ascr; +} + +sub selectall { + local (*map, *sel) = @_; + local ($v); + for $v (values %map) { + next if m/,/; + $sel{$v}=1; + } +} + +if ($action eq 'search') { + @ARGV || &badusage("need at least one glob pattern for --$action"); + &database_start; + while (@ARGV) { + $orgpat= $_= shift(@ARGV); + s/\W/\\$&/g; + s|\\\*\\\*|.*|g; + s|\\\*|[^/]*|g; + s|\\\?|[^/]|g; + $pat= $_; $f=0; + for $p (sort keys %st_p21) { + $s= $st_p2s{$p}; + next if $s eq 'not-installed' || $s eq 'config-files'; + &filesinpackage($arg, $package); + @ilist= grep(m/^$pat$/,@ilist); + next unless @ilist; + $f=1; + for $_ (@ilist) { print("$p: $_\n") || &outerr; } + } + if (!$f) { + print(STDERR "No packages found containing \`$orgpat'.\n") + || &bombout("writing to stderr: $!"); + $ecode= 1; + } + } + &database_finish; + exit($ecode); +} + +#*** lock and read in databases ***# + +&database_start; +&debug("databases read"); + +#*** derive argument list for --auto ***# + +if ($auto) { + if ($action eq 'install' || $action eq 'unpack' || $action eq 'avail') { + @ARGV || &badusage("need at least one directory for --$action --auto"); + pipe(RP,WP) || &bombout("create pipe for \`find': $!"); + defined($c= fork) || &bombout("fork for \`find': $!"); + if (!$c) { + close(RP); open(STDOUT,">& WP"); close(WP); + exec('find',@ARGV,'-name',$filename_pattern,'-type','f','-print0'); + die "$name: could not exec \`find': $!"; + } + close(WP); + $/="\0"; @ARGV= <RP>; $/="\n"; + eof || &bombout("read filenames from \`find': $!"); + close(RP); + $!=0; waitpid($c,0) eq $c || &bombout("wait for \`find' failed: $!"); + $? && &bombout("\`find' process returned error code ".&ecode); + @ARGV || &bombout("no packages found to $action"); + } else { + @ARGV && &badusage("no package names may be specified with --$action --auto"); + if ($action eq 'remove') { + eval 'sub condition { + $wants eq "deinstall" || $wants eq "purge" || return 0; + $cstatus eq "not-installed" && return 0; + $cstatus eq "config-files" && $wants eq "deinstall" && return 0; + return 1; + } 1;' || &internalerr("sub condition: $@"); + } elsif ($action eq 'configure') { + eval 'sub condition { + $wants eq "install" || return 0; + $cstatus eq "unpacked" || $cstatus eq "postinst-failed" || return 0; + return 1; + } 1;' || &internalerr("sub condition: $@"); + } else { + &internalerr("unknown auto nonames action $action"); + } + for $p (keys %st_p21) { + next if $st_p2h{$p} eq 'hold'; + $wants= $st_p2w{$p}; $cstatus= $st_p2s{$p}; + next unless &condition; + push(@ARGV,$p); + } + } + &debug("auto: arglist @ARGV"); +} else { + @ARGV || &badusage("need a list of packages or filenames"); +} + +if ($action eq 'install' || $action eq 'unpack') { + grep(s:^[^/.]:./$&:, @ARGV); # Sanitise filenames +} + +&debug("action: $action; arglist @ARGV"); + +#*** actually do things ***# + +for $arg (@ARGV) { + $package= ''; @undo=(); + &debug("&do_$action($arg)"); + if (!eval "&do_$action(\$arg); 1;") { &handleerror || last; } + &checkpointstatus; +} +&checkpointstatus; + +if (!$abort) { + &debug("&middle_$action($arg)"); + if (!eval "&middle_$action; 1;") { print STDERR $@; $abort=1; } +} +&checkpointstatus; + +if (!$abort) { + while (@deferred) { + $arg= shift(@deferred); $package= ''; @undo=(); + &debug("&deferred_$action($arg) ($dependtry: $sincenothing)"); + if (!eval "&deferred_$action(\$arg); 1;") { &handleerror || last; } + &checkpointstatus; + } + &checkpointstatus; +} + +if ($errors) { + print STDERR "$name: $errors errors occurred.\n"; + $estatus= 1; +} + +&database_finish; +&cleanup; + +exit($estatus); + +#*** useful subroutines for main control section ***# + +sub handleerror { + print STDERR $@; + if (length($package) && defined($st_p21{$package})) { + $st_p2h{$package}='hold'; &amended_status($package); + } + $errors++; + if ($errors >20) { print STDERR "$name: too many errors, halting\n"; return 0; } + return !$abort; +} + +sub checkpointstatus { + return unless keys %statusupdated; + &amended_status(keys %statusupdated); + undef %statusupdated; +} + +sub backend { + &setaction(''); + ($noptsdone) && &badusage("action \`$_[0]' must be first argument"); + &debug("backend --$_[0]"); + exec($backend, "--$_[0]", @ARGV); + &bombout("unable to run $backend: $!"); +} + +sub setaction { + $action eq 'none' || &badusage("conflicting actions \`$action' and \`$1'"); + $action= $_[0]; +} + +#*** error handlers for use in actions ***# + +sub warn { warn "$name - warning: @_\n"; } +sub subcriterr { warn "$name - subcritical error: @_\n"; $estatus=1; } +sub error { &acleanup; die "$name - error: @_\n"; } +sub internalerr { &acleanup; die "$name - internal error, please report: @_\n"; } +sub fatalerr { &acleanup; die "$name - fatal error, halting: @_\n"; $abort=1; } + +sub corruptingerr { + local ($corruptingerr)= @_; + &acleanup; + die "$name - horrible error: $corruptingerr;\n". + "Package manager data is now out of step with installed system.\n". + "Please re-install \`$package' to ensure system consistency!\n". + "(Seek assistance from an expert if problems persist.)\n"; + $abort=1; +} + +sub forcibleerr { + local ($msg,@forces) = @_; + if (@forces= grep($force{$_},@forces)) { + &warn("$msg (proceeding due to --force-$forces[0])"); + } else { + &error("$msg (skipping this package)"); + } +} + +sub acleanup { + while (@undo) { + eval(pop(@undo)); + $@ && print STDERR "error while cleaning up: $@"; + } +} + +#*** --install ***# + +sub do_install { + &do_unpack($arg); + $arg= $package; + &do_configure($arg); +} + +sub deferred_install { &deferred_configure; } + +sub middle_install { &middle_configure } + +#*** --avail ***# + +sub do_avail { + unlink($controli); + if ($! != &ENOENT) { + system('rm','-rf',$controli); + unlink($controli); + $! == &ENOENT || &fatalerr("unable to get rid of $controli: $!"); + } + &debug("extract control $backend --control $arg $controli"); + $!=0; system($backend,"--control",$arg,$controli); + $? && &error("$arg: could not extract control information (".&ecode.")"); + open(CONTROL,"$controli/control") || + &error("$arg: corrupt - unable to read control file: $!"); + &parse_control("$arg"); + for $k (keys %cf_k2v) { + $av_pk2v{$p,$k}= $cf_k2v{$k}; + } + for $k (@nokeepfields) { + delete $av_pk2v{$p,$k} unless defined($cf_k2v{$k}); + } + &amended_available($p); + $package=$p; +} + +sub deferred_avail { } +sub middle_avail { } + +#*** --unpack ***# + +sub middle_unpack { } + +sub do_unpack { + &do_avail; + $cstatus= $st_p2s{$package}; + if ($st_p2w{$package} ne 'install') { + if (!$noalsoselect) { + $st_p2w{$package}= 'install'; $statusupdated{$package}= 1; + print STDOUT "Selecting previously deselected package $package.\n"; + } else { + print STDOUT "Skipping deselected package $package.\n"; + return; + } + } + for $tp (split(/,/, $av_pk2v{$package,'conflicts'})) { + $tp =~ s/^\s*//; $tp =~ s/\s+$//; + ($tps, $rightver, $inst, $want, $tpp)= &installationstatus($tp); + unless ($tps eq 'not-installed' || $tps eq 'config-files' || !$rightver) { + &forcibleerr("$arg: conflicts with package $tpp ($want),". + " found $inst on system", + 'conflicts'); + } + } + if ($cstatus eq 'installed') { + if (&compare_verrevs($av_pk2v{$package,'version'}, + $av_pk2v{$package,'package_revision'}, + $st_k2v{'version'},$st_k2v{'package_revision'}) <0) { + &forcibleerr("$arg: downgrading installed $package version ". + "$st_k2v{'version'}, ". + "package revision $st_k2v{'package_revision'} ". + "to older version ". + "$av_pk2v{$package,'version'}, ". + "package revision $av_pk2v{$package,'package_revision'}", + 'downgrade'); + } + } + if (open(CONF,"$controli/conffiles")) { + @configf= <CONF>; + eof || &error("$arg: unable to read $controli/conffiles: $!"); + close(CONF); + grep((chop, m,^/, || s,^,/,), @configf); + } elsif ($! != &ENOENT) { + &error("$arg: cannot get config files list: $!"); + } else { + @configf= (); + } + + if ($cstatus eq 'installed' || $cstatus eq 'unpacked' || + $cstatus eq 'postinst-failed' || $cstatus eq 'removal-failed') { + &filesinpackage($arg,$package); + print STDOUT "Preparing to replace $package ...\n"; + } + if ($cstatus eq 'installed') { + if (!eval { + &run_script_ne("$scriptsdir/$package.prerm", 'old pre-removal script', + 'upgrade', + $av_pk2v{$package,'version'}.'-'. + $av_pk2v{$package,'package_revision'}); + 1; + }) { + &warn("$@... trying script from new package instead."); + &run_script("$controli/prerm", 'new prerm script', + 'failed-upgrade', + $st_k2v{'version'}.'-'.$st_k2v{'package_revision'}); + } + push(@undo, + '$st_p2s{$package}= "postinst-failed"; $statusupdated{$package}=1; + &run_script_ne("$scriptsdir/$package.postinst", + "old post-installation script", + "abort-upgrade", + $av_pk2v{$package,"version"}."-". + $av_pk2v{$package,"package_revision"}); + $st_p2s{$package}= "installed"; $statusupdated{$package}=1;'); + } + @fbackups=(); + if ($cstatus eq 'installed' || $cstatus eq 'unpacked' || + $cstatus eq 'postinst-failed' || $cstatus eq 'removal-failed') { + for ($i=0; $i<=$#ilist; $i++) { + next if grep($_ eq $ilist[$i], @configf); + $_= $ilist[$i]; + unless (lstat("$instroot/$_")) { + $! == &ENOENT || &error("old file $_ unstattable: $!"); + next; + } + next if -d _; + rename("$instroot/$_","$instroot/$_.dpkg-tmp") || + &error("couldn't rename old file $_ to $_.dpkg-tmp: $!"); + push(@undo, + '$_=pop(@fbackups); rename("$instroot/$_.dpkg-tmp","$instroot/$_") || + die "unable to undo rename of $_ to $_.dpkg-tmp: $!"'); + push(@fbackups, $_); + } + if (!eval { + &run_script_ne("$scriptsdir/$package.postrm", 'old post-removal script', + 'upgrade', + $av_pk2v{$package,'version'}.'-'. + $av_pk2v{$package,'package_revision'}); + 1; + }) { + &warn("$@... trying script from new package instead."); + &run_script("$controli/postrm", 'new post-removal script', + 'failed-upgrade', + $st_k2v{'version'}.'-'.$st_k2v{'package_revision'}); + } + push(@undo, + '&run_script_ne("$scriptsdir/$package.preinst", + "old pre-installation script", + "abort-upgrade", + $av_pk2v{$package,"version"}. + "-".$av_pk2v{$package,"package_revision"})'); + } + $shortarg= $arg; $shortarg =~ s:.{15,}/:.../:; + print STDOUT "Unpacking $arg, containing $package ...\n"; + &run_script("$controli/preinst", 'pre-installation script', + 'upgrade', $st_k2v{'version'}.'-'.$st_k2v{'package_revision'}); + push(@undo,'&run_script_ne("$controli/postrm", "post-removal script", + "abort-upgrade", + $st_k2v{"version"}."-".$st_k2v{"package_revision"})'); + if ($cstatus ne 'not-installed') { + for $_ (split(/\n/,$st_pk2v{$package,'conffiles'})) { + s/^ //; next unless length($_); + if (!m/^(\S+) (-|newconffile|nonexistent|[0-9a-f]{32})$/) { + &warn("$arg: ignoring bad stuff in old conffiles field \`$_'"); + next; + } + $oldhash{$1}= $2; + } + } + for $f (@configf) { + $drf= &conffderef($f); if (!defined($drf)) { next; } + if (lstat("$instroot/$drf.dpkg-tmp")) { + $undo=1; + } else { + $! == &ENOENT || &error("unable to stat backup config file $_.dpkg-tmp: $!"); + if (lstat("$instroot/$drf")) { + rename("$instroot/$drf","$instroot/$drf.dpkg-tmp") || + &error("couldn't back up config file $f (= $drf): $!"); + $undo=1; + } elsif ($! == &ENOENT) { + $undo=0; + } else { + &error("unable to stat config file $drf: $!"); + } + } + if ($undo) { + push(@undo, + '$_=pop(@undof); rename("$instroot/$_.dpkg-tmp","$instroot/$_") || + die "unable to undo backup of config file $_: $!"'); + push(@undof, $drf); + } + } + + open(NL,">$listsdir/$package.list.new") || + &error("$package: cannot create $listsdir/$package.list.new: $!"); + defined($c= fork) || &error("$package: cannot pipe/fork for $backend --vextract"); + if (!$c) { + if (!open(STDOUT,">&NL")) { + print STDERR "$name: cannot redirect stdout: $!\n"; exit(1); + } + $vexroot= length($instroot) ? $instroot : '/'; + exec($backend,"--vextract",$arg,$vexroot); + print STDERR "$name: cannot exec $backend --vextract $arg $vexroot: $!\n"; + exit(1); + } + $!=0; waitpid($c,0) == $c || &error("could not wait for $backend: $!"); + $? && &forcibleerr("$package: failed to install (".&ecode.")", 'extractfail'); + + rename("$listsdir/$package.list.new","$listsdir/$package.list") || + &error("$package: failed to install new $listsdir/$package.list: $!"); + + $newconff=''; + for $f (@configf) { + $h= $oldhash{$f}; + $h='newconffile' unless length($h); + $newconff.= "\n $f $h"; + &debug("new hash, after unpack, of $f, is $h"); + } + + for $k (keys %all_k21) { + next if $k eq 'binary' || $k eq 'source' || $k eq 'section'; + $st_pk2v{$package,$k}= $av_pk2v{$package,$k}; + } + $st_pk2v{$package,'conffiles'}= $newconff; $all_k21{'conffiles'}= 1; + $st_p2s{$package}= 'unpacked'; $st_p2h{$package}= 'ok'; $st_p21{$package}= 1; + $statusupdated{$package}= 1; + @undo=(); @undof=(); + + for $f (@fbackups) { + unlink("$instroot/$f.dpkg-tmp") || $! == &ENOENT || + &subcriterr("$package: unable to delete saved old file $f.dpkg-tmp: $!\n"); + } + + undef %fordeletion; + opendir(PI,"$scriptsdir") || + &corruptingerr("$package: unable to read $scriptsdir directory ($!)"); + while(defined($_=readdir(PI))) { + next unless substr($_,0,length($package)+1) eq $package.'.'; + $fordeletion{$_}= 1; + } + closedir(PI); + opendir(PI,"$controli") || + &corruptingerr("$package: unable to read $controli". + " new package control information directory ($!)"); + $fordeletion{"$package.list"}= 0; + while(defined($_=readdir(PI))) { + next if m/^\.\.?$/ || m/^conffiles$/ || m/^control$/; + rename("$controli/$_","$scriptsdir/$package.$_") || + &corruptingerr("$package: unable to install new package control". + " information file $scriptsdir/$package.$_ ($!)"); + $fordeletion{"$package.$_"}= 0; + } + closedir(PI); + for $_ (keys %fordeletion) { + next unless $fordeletion{$_}; + unlink("$scriptsdir/$_") || + &corruptingerr("$package: unable to remove old package script". + " $scriptsdir/$_ ($!)"); + } +} + +#*** --configure ***# + +sub do_configure { + $package=$arg; $cstatus= $st_p2s{$package}; + if (!defined($st_p21{$package})) { $cstatus= 'not-installed'; } + unless ($cstatus eq 'unpacked' || $cstatus eq 'postinst-failed') { + if ($cstatus eq 'not-installed') { + &error("no package named \`$package' is installed, cannot configure"); + } else { + &error("$package: is currently in state \`$cstatus', cannot configure"); + } + } + push(@deferred,$package); +} + +sub middle_configure { + $sincenothing=0; $dependtry=1; +} + +sub deferred_configure { + # The algorithm for deciding what to configure first is as follows: + # Loop through all packages doing a `try 1' until we've been round + # and nothing has been done, then do `try 2' and `try 3' likewise. + # Try 1: + # Are all dependencies of this package done ? If so, do it. + # Are any of the dependencies missing or the wrong version ? + # If so, abort (unless --force-depends, in which case defer) + # Will we need to configure a package we weren't given as an + # argument ? If so, abort - except if --force-configure-any, + # in which case we add the package to the argument list. + # If none of the above, defer the package. + # Try 2: + # Find a cycle and break it (see above). + # Do as for try 1. + # Try 3 (only if --force-depends-version). + # Same as for try 2, but don't mind version number in dependencies. + # Try 4 (only if --force-depends). + # Do anyway. + $package= $arg; + if ($sincenothing++ > $#deferred*2+2) { + $dependtry++; $sincenothing=0; + &internalerr("$package: nothing configured, but try was already 4 !") + if $dependtry > 4; + } + if ($dependtry > 1) { &findbreakcycle($package); } + ($ok, @aemsgs) = &dependencies_ok($package,''); + if ($ok == 1) { + push(@deferred,$package); return; + } elsif ($ok == 0) { + $sincenothing= 0; + &error("$arg: dependency problems - not configuring this package:\n ". + join("\n ",@aemsgs)); + } elsif (@aemsgs) { + &warn("$arg: dependency problems, configuring anyway as you request:\n ". + join("\n ",@aemsgs)); + } + $sincenothing= 0; + print STDOUT "Setting up $package ...\n"; + if ($st_p2s{$package} eq 'unpacked') { + &debug("conffiles updating >$st_pk2v{$package,'conffiles'}<"); + undef %oldhash; @configf=(); + for $_ (split(/\n/,$st_pk2v{$package,'conffiles'})) { + s/^ //; next unless length($_); + if (!m/^(\S+) (-|newconffile|nonexistent|[0-9a-f]{32})$/) { + &warn("$arg: ignoring bad stuff in old conffiles field \`$_'"); + next; + } + $oldhash{$1}= $2; push(@configf,$1); + &debug("old hash of $1 is $2"); + } + undef %newhash; + for $file (@configf) { + $drf= &conffderef($file); + if (!defined($drf)) { $newhash{$file}= '-'; next; } + $newhash{$file}= &hash("$instroot/$drf"); + &debug("new hash of $file is $newhash{$file} (old $oldhash{$file})"); + if ($oldhash{$file} eq 'newconffile') { + $usenew= 1; + } else { + if (!&files_not_identical("$instroot/$drf", + "$instroot/$drf.dpkg-tmp")) { + rename("$instroot/$drf.dpkg-tmp",$drf) || $!==&ENOENT || + &error("$package: unable to reinstall ". + "existing conffile $drf.dpkg-tmp: $!"); + &debug("files identical $file"); + } else { + $diff= $newhash{$file} ne $oldhash{$file}; + $usenew= $confusenew[$diff]; + &debug("the decision - diff $diff;". + " usenew $usenew prompt $confpromt[$diff]"); + if ($confprompt[$diff]) { + $symlinked = $drf eq $file ? '' : + $succinct ? " (-> $drf)" : + " (which is a symlink to $drf)"; + for (;;) { + print + $succinct ? " +Package $package, file $file$symlinked, ".($diff ? "CHANGED": "not changed") + : $diff ? " +In package $package, distributed version of configuration +file $file$symlinked has changed +since the last time it was installed. You may: + * Install the new version and edit it later to reflect your wishes. + ". ($nokeepold ? + "(Your old version will not be saved.)" : + "(Your old version will be saved in $drf.dpkg-old.)") . " + * Leave your old version in place, and perhaps check later that + you don't want to update it to take account of new features. + ". ($nokeepnew ? + "(The new version be discarded.)" : + "(The new version will be placed in $drf.dpkg-new.)") + : " +Package $package contains the same distributed version of +configuration file $file$symlinked +as the last time it was installed. You may: + * Install the distributed version, overwriting your changes. + ". ($nokeepold ? + "(Your changed version will not be saved.)" : + "(Your changed version will be saved in $drf.dpkg-old.)") . " + * Leave your own version in place. + ". ($nokeepnew ? + "(The distributed version be discarded.)" : + "(The distributed version will be placed in $drf.dpkg-new.)"); + + print " +$file: install new version ? (y/n, default=". ($usenew?'y':'n'). ") "; + + $!=0; defined($iread= <STDIN>) || + &error("$package: prompting, EOF/error on stdin: $!"); + $_= $iread; s/^\s*//; s/\s+$//; + ($usenew=0, last) if m/^n(o)?$/i; + ($usenew=1, last) if m/^y(es)?$/i; + last if m/^$/; + print "\nPlease answer \`y' or \`n'.\n"; + } + } + &debug("decided, usenew $usenew"); + if ($usenew) { + ©perm("$drf.dpkg-tmp",$drf,$drf); + if ($nokeepold) { + unlink("$instroot/$drf.dpkg-tmp") || $!==&ENOENT || + &error("$package: unable to delete old conffile ". + "$drf.dpkg-tmp: $!"); + unlink("$instroot/$drf.dpkg-old") || $!==&ENOENT || + &error("$package: unable to delete very old ". + "conffile $drf.dpkg-old: $!"); + } else { + rename("$instroot/$drf.dpkg-tmp","$instroot/$drf.dpkg-old") + || $!==&ENOENT || + &error("$package: unable to back up old conffile ". + "$drf.dpkg-tmp as $drf.dpkg-old: $!"); + } + } else { + unlink("$instroot/$drf.dpkg-new") || $!==&ENOENT || + &error("$package: unable to delete old new conffile ". + "$drf.dpkg-new: $!"); + if (!$nokeepnew) { + link("$instroot/$drf","$instroot/$drf.dpkg-new") + || $!==&ENOENT || + &error("$package: unable save new conffile ". + "$drf as $drf.dpkg-new: $!"); + } + if (!rename("$instroot/$drf.dpkg-tmp","$instroot/$drf")) { + $!==&ENOENT || &error("$package: unable reinstall old ". + "conffile $drf.dpkg-tmp as $drf: $!"); + unlink("$instroot/$drf"); + } + } + } + } + } + $newconff=''; + for $f (@configf) { + $h= $newhash{$f}; $newconff.= "\n $f $h"; + } + $st_pk2v{$package,'conffiles'}= $newconff; $all_k21{'conffiles'}= 1; + } + $st_p2s{$package}= 'postinst-failed'; $statusupdated{$package}= 1; + &run_script("$scriptsdir/$package.postinst", + 'post-installation script', 'configure'); + $st_p2s{$package}= 'installed'; + $st_p2h{$package}= 'ok'; $statusupdated{$package}= 1; +} + +#*** --remove ***# + +sub do_remove { + $package=$arg; $cstatus= $st_p2s{$package}; + if (!defined($st_p21{$package}) || + $cstatus eq 'not-installed' || + !$purge && $cstatus eq 'config-files') { + &error("$package: is not installed, cannot remove"); + } + push(@deferred,$package); + if (!$auto) { + $ns= $purge ? 'purge' : 'deinstall'; + if ($st_p2w{$package} ne $ns) { + $st_p2w{$package}= $ns; $statusupdated{$package}= 1; + } + } +} + +sub middle_remove { + $sincenothing=0; $dependtry=1; + for $p (keys %st_p2s) { + $cstatus= $st_p2s{$p}; + next unless $cstatus eq 'installed'; + for $tp (split(/[\|,]/, $st_pk2v{$p,'depends'})) { + $tp =~ s/\s*\(.+\)\s*$//; $tp =~ s/^\s*//; $tp =~ s/\s+$//; + $tp =~ m/^$packagere$/o || + &internalerr("package $p dependency $tp didn't match re"); + $depended{$tp}.= "$p "; + } + } +} + +sub deferred_remove { + $package= $arg; + if ($sincenothing++ > $#deferred*2+2) { + $dependtry++; $sincenothing=0; + &internalerr("$package: nothing configured, but try was already 4 !") + if $dependtry > 4; + } + @raemsgs= (); $rok= 2; + &debug("$package may be depended on by any of >$depended{$package}<"); + for $fp (split(/ /, $depended{$package})) { + next if $fp eq '' || $ignore_depends{$tp}; + $is= $st_p2s{$fp}; + next if $is eq 'not-installed' || $is eq 'unpacked' || + $is eq 'removal-failed' || $is eq 'config-files'; + if ($dependtry > 1) { &findbreakcycle($fp); } + ($ok, @aemsgs) = &dependencies_ok($fp,$package); + if ($rok != 1) { push(@raemsgs,@aemsgs); } + $rok= $ok if $ok < $rok; + } + if ($rok == 1) { + push(@deferred,$package); return; + } elsif ($rok == 0) { + $sincenothing= 0; + &error("$arg: dependency problems - not removing this package:\n ". + join("\n ",@raemsgs)); + } elsif (@raemsgs) { + &warn("$arg: dependency problems, removing anyway as you request:\n ". + join("\n ",@raemsgs)); + } + $sincenothing= 0; + &filesinpackage($arg,$package); + + undef %hash; @configfr= @configf= (); + for $_ (split(/\n/,$st_pk2v{$package,'conffiles'})) { + s/^ //; next unless length($_); + if (!m/^(\S+) (-|newconffile|nonexistent|[0-9a-f]{32})$/) { + &warn("$arg: ignoring bad stuff in old conffiles field \`$_'"); + next; + } + unshift(@configfr,$1); push(@configf,$1); + $hash{$1}= $2; + } + + if ($st_p2s{$package} ne 'config-files') { + print STDOUT "Removing $package ...\n"; + &run_script("$scriptsdir/$package.prerm", 'pre-removal script', 'remove'); + $st_p2s{$package}= 'removal-failed'; $statusupdated{$package}= 1; + for $file (reverse @ilist) { + next if grep($_ eq $file, @configf); + unlink("$instroot/$file.dpkg-tmp") || $! == &ENOENT || + &error("$arg: cannot remove supposed old temp file $file: $!"); + next if unlink("$instroot/$file"); + next if $! == &ENOENT; + &error("$arg: cannot remove file $file: $!") unless $! == &EISDIR; + next if rmdir("$instroot/$file"); + &error("$arg: cannot remove directory $file: $!") unless $! == &ENOTEMPTY; + } + &run_script("$scriptsdir/$package.postrm", 'post-removal script', 'remove'); + opendir(DSD,"$scriptsdir") || + &error("$arg: cannot read directory $scriptsdir: $!"); + for $_ (readdir(DSD)) { + next unless m/\.[^.]$/; + next if $& eq '.postrm' || $& eq '.list'; + # need postrm for --purge, and list has to go last in case it + # goes wrong + next unless $` eq $package; + unlink("$scriptsdir/$_") || + &error("$arg: unable to delete control information $scriptsdir/$_: $!"); + } + closedir(DSD); + $st_p2s{$package}= 'config-files'; + $statusupdated{$package}= 1; + } + if ($purge) { + print STDOUT "Purging configuration files for $package ...\n"; + push(@undo, + '$newconff=""; + for $f (@configf) { $newconff.= "\n $f $hash{$f}"; } + $st_pk2v{$package,"conffiles"}= $newconff; $all_k21{"conffiles"}= 1;'); + for $file (@configfr) { + $drf= &conffderef($file); if (!defined($drf)) { next; } + unlink("$instroot/$drf") || $! == &ENOENT || + &error("$arg: cannot remove old config file $file (= $drf): $!"); + $hash{$file}= 'newconffile'; + unlink("$instroot/$file") || $! == &ENOENT || + &error("$arg: cannot remove old config file $file: $!") + if $file ne $drf; + for $ext ('.dpkg-tmp', '.dpkg-old', '.dpkg-new', '~', '.bak', '%') { + unlink("$instroot/$drf$ext") || $! == &ENOENT || + &error("$arg: cannot remove old config file $drf$ext: $!"); + } + unlink("#$instroot/$drf#") || $! == &ENOENT || + &error("$arg: cannot remove old auto-save file #$drf#: $!"); + $drf =~ m,^(.*)/, || next; $dir= $1; $base= $'; + if (opendir(CFD,"$instroot/$dir")) { + for $_ (readdir(CFD)) { + next unless m/\.~\d+~$/; + next unless $` eq $base; + unlink("$instroot/$dir/$_") || $! == &ENOENT || + &error("$arg: cannot remove old emacs backup file $dir/$_: $!"); + } + closedir(CFD); + if (grep($_ eq $dir, @ilist)) { + rmdir("$instroot/$dir") || $! == &ENOTEMPTY || + &error("$arg: cannot remove config file directory $dir: $!"); + } + } elsif ($! != &ENOENT) { + &error("$arg: cannot read config file dir $dir: $!"); + } + } + &run_script("$scriptsdir/$package.postrm", 'post-removal script for purge', + 'purge'); + unlink("$scriptsdir/$package.postrm") || $! == &ENOENT || + &error("$arg: cannot remove old postrm script: $!"); + &setnotinstalled; + @undo= (); + } elsif (!@configf && !stat("$scripts/$package.postrm")) { + # If there are no config files and no postrm script then we + # go straight into `purge'. However, perhaps the stat didn't + # fail with ENOENT ... + $! == &ENOENT || &error("$package: stat failed on postrm script: $!"); + $st_p2w{$package}= 'purge'; + &setnotinstalled; + } + $st_p2h{$package}= 'ok'; $statusupdated{$package}= 1; +} + +sub setnotinstalled { + unlink("$listsdir/$package.list") || + &error("$arg: unable to delete old file list: $!"); + $st_p2s{$package}= 'not-installed'; + for $k (keys %all_k21) { delete $st_pk2v{$package,$k}; } +} + +#*** dependency processing - common to --configure and --remove ***# + +# The algorithm for deciding what to configure or remove first is as +# follows: +# +# Loop through all packages doing a `try 1' until we've been round and +# nothing has been done, then do `try 2' and `try 3' likewise. +# +# When configuring, in each try we check to see whether all +# dependencies of this package are done. If so we do it. If some of +# the dependencies aren't done yet but will be later we defer the +# package, otherwise it is an error. +# +# When removing, in each try we check to see whether there are any +# packages that would have dependencies missing if we removed this +# one. If not we remove it now. If some of these packages are +# themselves scheduled for removal we defer the package until they +# have been done. +# +# The criteria for satisfying a dependency vary with the various +# tries. In try 1 we treat the dependencies as absolute. In try 2 we +# check break any cycles in the dependency graph involving the package +# we are trying to process before trying to process the package +# normally. In try 3 (which should only be reached if +# --force-depends-version is set) we ignore version number clauses in +# Depends lines. In try 4 (only reached if --force-depends is set) we +# say "ok" regardless. +# +# If we are configuring and one of the packages we depend on is +# awaiting configuration but wasn't specified in the argument list we +# will add it to the argument list if --configure-any is specified. +# In this case we note this as having "done something" so that we +# don't needlessly escalate to higher levels of dependency checking +# and breaking. + +sub dependencies_ok { + local ($dp, $removingp) = @_; + local ($tpo, $however_t, $ok, $found, @aemsgs, @oemsgs); + local ($tp, $rightver, $inst, $want, $thisf, $matched, $tpp); + $ok= 2; # 2=ok, 1=defer, 0=halt + &debug("checking dependencies of $dp (- $removingp)"); + for $tpo (split(/,/, $st_pk2v{$dp,'depends'})) { + $tpo =~ s/^\s*//; $tpo =~ s/\s+$//; + &debug(" checking group $dp -> $tpo"); + $matched= 0; @oemsgs=(); + $found=0; # 0=none, 1=defer, 2=withwarning, 3=ok + for $tp (split(/\|/, $tpo)) { + $tp =~ s/^\s*//; $tp =~ s/\s+$//; + &debug(" checking possibility $dp -> $tp"); + if ($ignore_depends{$tp}) { &debug("ignoring so ok"); $found=3; last; } + if (defined($cyclebreak{$dp,$tp})) { &debug("break cycle"); $found=3; last; } + if ($tp eq $removingp) { + ($tps, $rightver, $inst, $want, $tpp)= ('removing-now', 1, '','', $tp); + $matched= 1; + } else { + ($tps, $rightver, $inst, $want, $tpp)= &installationstatus($tp); + &debug("installationstatus($tp) -> !$tps!$rightver!$inst!$want!$tps|"); + } + if (($tps eq 'installed' || $tps eq 'unpacked' || $tps eq 'postinst-failed') + && !$rightver) { + push(@oemsgs,"version of $tpp on system is $inst (wanted $want)"); + if ($force{'depends'}) { $thisf= $dependtry >= 3 ? 2 : 1; } + } elsif ($tps eq 'unpacked' || $tps eq 'postinst-failed') { + if (grep($_ eq $tpp, @deferred)) { + $thisf=1; + } elsif (!length($removingp) && $force{'configure-any'}) { + &warn("will also configure $tpp"); + push(@deferred,$tpp); $sincenothing=0; $thisf=1; + } else { + push(@oemsgs,"package $tpp is not configured yet"); + if ($force{'depends'}) { $thisf= $dependtry >= 4 ? 2 : 1; } + } + } elsif ($tps eq 'installed') { + $found=3; last; + } elsif ($tps eq 'removing-now') { + push(@oemsgs,"$tpp is to be removed"); + if ($force{'depends'}) { $thisf= $dependtry >= 4 ? 2 : 1; } + } else { + push(@oemsgs,"$tpp ($want) is not installed"); + if ($force{'depends'}) { $thisf= $dependtry >= 4 ? 2 : 1; } + } + &debug(" found $found"); + $found=$thisf if $thisf>$found; + } + &debug(" found $found matched $matched"); + next if length($removingp) && !$matched; + if (length($removingp) && $tpo !~ m/\|/) { + $however_t= ''; + } elsif (@oemsgs > 1) { + $however_t= "\n However, ". join(",\n ", @oemsgs[0..($#oemsgs-1)]). + " and\n ". $oemsgs[$#oemsgs]. "."; + } else { + $however_t= "\n However, @oemsgs."; + } + if ($found == 0) { + push(@aemsgs, "$dp depends on $tpo.$however_t"); + $ok=0; + } elsif ($found == 1) { + $ok=1 if $ok>1; + } elsif ($found == 2) { + push(@aemsgs, "$dp depends on $tpo.$however_t"); + } elsif ($found != 3) { + &internalerr("found value in deferred_configure $found not known"); + } + } + &debug("ok $ok msgs >>@aemsgs<<"); + return ($ok, @aemsgs); +} + +sub findbreakcycle { + # Cycle breaking works recursively down the package dependency + # tree. @sofar is the list of packages we've descended down + # already - if we encounter any of its packages again in a + # dependency we have found a cycle. + # + # Cycles are preferentially broken by ignoring a dependency from + # a package which doesn't have a postinst script. If there isn't + # such a dependency in the cycle we break at the `start' of the + # cycle from the point of view of our package. + # + local ($package,@sofar) = @_; + local ($tp,$tpp,$tps,$rightver,$inst,$want,$i,$dr,$de,@sf); + &debug("findbreakcycle($package; @sofar)"); + push(@sofar,$package); + for $tp (split(/[,|]/, $st_pk2v{$package,'depends'})) { + $tp =~ s/^\s*//; $tp =~ s/\s+$//; + ($tps, $rightver, $inst, $want, $tpp)= &installationstatus($tp); + next unless $tps eq 'config-files' || $tps eq 'unpacked'; + next if $cyclebreak{$package,$tpp}; + if (grep($_ eq $tpp, @sofar)) { + &debug("found cycle $package, $tpp (@sofar)"); + @sf= (@sofar,$tpp); + for ($i=0; + $i<$#sf; + $i++) { + next if stat("$scriptsdir/$sf[$i].postinst"); + last if $! == &ENOENT; + &error("$arg: unable to stat $scriptsdir/$sf[$i].postinst: $!"); + } + $i=0 if $i>=$#sf; + ($dr,$de)= @sf[$i..$i+1]; + if (!defined($cyclebreak{$dr,$de})) { + $sincenothing=0; $cyclebreak{$dr,$de}= 1; + &debug("broken cycle $i (@sf) at $dr -> $de"); + return 1; + } + } else { + return if &findbreakcycle($tpp,@sofar); + } + } + return 0; +} + +#*** useful subroutines for actions ***# + +sub filesinpackage { + # Returns the list in @ilist. + # If error, calls &error("$epfx: ..."); + local ($epfx, $package) = @_; + open(LIST,"$listsdir/$package.list") || + &error("$epfx: database broken for $package - ". + "can't get installed files list: $!"); + @ilist= <LIST>; + eof || &error("$epfx: cannot read $listsdir/$package.list: $!"); + close(LIST); + @ilist= grep((chop, + s|/$||, + m|^/| || s|^|/|, + m/./), + @ilist); +} + +sub installationstatus { + local ($controlstring) = @_; + local ($lversion,$lpackage,$lstatus,$lrevision,$cmp) = @_; + local ($cc); + $lversion= $controlstring; + $lversion =~ s/^($packagere)\s*// || + &internalerr("needed installation status of bogus thing \`$lversion'"); + $lpackage= $1; + $lstatus= defined($st_p2s{$lpackage}) ? $st_p2s{$lpackage} : 'not-installed'; + if ($lstatus ne 'not-installed') { + if (length($lversion)) { + $lversion =~ s/^\s*\(\s*// && $lversion =~ s/\s*\)\s*$// || + &internalerr("failed to strip version \`$lversion'"); + if ($lversion =~ s/^[><=]//) { $cc= $&; } else { $cc= '='; } + $lrevision = ($lversion =~ s/-([^-]+)$//) ? $1 : ''; + $wantedstring= "version $lversion"; + $wantedstring .= ", package revision $lrevision" if length($lrevision); + $cmp= &compare_verrevs($st_pk2v{$lpackage,'version'}, + $st_pk2v{$lpackage,'package_revision'}, + $lversion, + $lrevision); + $installedstring= "version $st_pk2v{$lpackage,'version'}"; + $installedstring .= + ", package revision $st_pk2v{$lpackage,'package_revision'}" + if length($st_pk2v{$lpackage,'package_revision'}); + if ($cc eq '>') { + $rightver= $cmp>=0; $wantedstring.= ' or later'; + } elsif ($cc eq '<') { + $rightver= $cmp<=0; $wantedstring.= ' or earlier'; + } else { + s/^=//; + $rightver= !$cmp; $wantedstring= "exactly $wantedstring"; + } + } else { + $rightver= 1; + $wantedstring= "any version"; + $installedstring= $st_pk2v{$lpackage,'version'}.'-'. + $st_pk2v{$lpackage,'package_revision'}; + } + } else { + $rightver= -1; + $installedstring= "not installed"; + } + return ($lstatus,$rightver,$installedstring,$wantedstring,$lpackage); +} + +sub parse_control { + # reads from fh CONTROL + local ($fn) = @_; + local ($cf,$ln,$l,$k,$v); + defined($cf= &readall('CONTROL')) || &error("read control file $fn: $!"); + close(CONTROL); + $p= &parse_control_entry; + if (@cwarnings) { + &warn("$fn: control file contains oddities: ".join("; ",@cwarnings)) + unless $controlwarn; + } + if (@cerrors) { + &error("$fn: control file contains errors: ".join("; ",@cerrors)); + } +} + +sub run_script_ne { + local ($script,$describe,@args) = @_; + local ($extranewlines) = $script =~ m/postinst/; + &debug("running $describe = $script @args"); + if (!stat("$script")) { + return if $! == &ENOENT; + die "couldn't stat $script: $!\n"; + } + if (! -x _) { + chmod(0755, "$script") || die "couldn't make $script executable: $!\n"; + } + print "\n" if $extranewlines; + &debug("forking now"); + defined($rsc= fork) || die "couldn't fork for running $script: $!\n"; + if (!$rsc) { + if ($instroot !~ m|^/*$| && !chroot($instroot)) { + print STDERR "$name: failed to chroot to $instroot for $describe: $!\n"; + exit(1); + } + exec($script,@args); + print STDERR "$name: failed to exec $script: $!\n"; + exit(1); + } + $!=0; waitpid($rsc,0) == $rsc || die "couldn't wait for $describe: $!\n"; + $? && die "$describe failed (".&ecode.")\n"; + &debug("script done"); + print "\n" if $extranewlines; +} + +sub run_script { + return if eval { &run_script_ne; 1; }; + $rse= $@; chop($rse); &error("$package: $rse"); +} + +sub hash { + local ($file) = @_; # NB: filename must already have $instroot here + local ($c); + if (open(HF,"<$file")) { + defined($c= open(MDP,"-|")) || &error("fork/pipe for hash: $!"); + if (!$c) { + if (!open(STDIN,"<&HF")) { + print STDERR "$name: unable to redirect stdin for hash: $!\n"; exit(1); + } + exec($md5sum); print STDERR "$name: unable to exec $md5sum: $!\n"; exit(1); + } + defined($hash= &readall('MDP')) || &error("unable to read from $md5sum: $!\n"); + $!=0; close(MDP); $? && &error("$md5sum returned error (".&ecode.")"); + $hash =~ s/\n+$//; + $hash =~ m/^[0-9a-f]{32}$/i || &error("$md5sum returned bogus output \`$hash'"); + return $hash; + } elsif ($! == &ENOENT) { + return 'nonexistent'; + } else { + &warn("$arg: unable to open conffile $file for hash: $!"); + return '-'; + } +} + +sub files_not_identical { + local ($file1,$file2) = @_; # NB: filenames must already have $instroot here + if (stat($file1)) { + if (stat($file2)) { + system("cmp","-s",$file1,$file2); + if (&WIFEXITED($?)) { + $es= &WEXITSTATUS($?); + return $es if $es == 0 || $es == 1; + } + &error("cmp $file1 $file2 returned error (".&ecode.")"); + } elsif ($! == &ENOENT) { + return 1; + } else { + &error("failed to stat conffile $file2: $!"); + } + } elsif ($! == &ENOENT) { + if (stat($file2)) { + return 1; + } elsif ($! == &ENOENT) { + return 0; + } else { + &error("failed to stat conffile $file2: $!"); + } + } else { + &error("failed to stat conffile $file1: $!"); + } +} + +sub copyperm { + local ($from,$to,$name) = @_; + if (@statv= stat("$instroot/$from")) { + chown($statv[4],$statv[5],"$instroot/$to") || + $!==&ENOENT || + &warn("$package: unable to preserve ownership of $name"); + chmod($statv[2],"$instroot/$to") || + $!==&ENOENT || + &warn("$package: unable to preserve permissions of $name"); + } elsif ($! != &ENOENT) { + &warn("$package: unable to check permissions and ownership of". + " $name in order to preserve them"); + } +} + +sub conffderef { + local ($file) = @_; + local ($drf, $warning); + $drf= $file; $warning=''; + for (;;) { + if (!lstat("$instroot/$drf")) { + last if $! == &ENOENT; $warning= "unable to lstat: $!"; last; + } elsif (-f _) { + last; + } elsif (-l _) { + if (!defined($lv= readlink("$instroot/$drf"))) { + $warning= "unable to readlink: $!"; last; + } + if ($lv =~ m|^/|) { + $drf= $lv; + } else { + $drf =~ s|/[^/]+$|/$lv|; + } + } else { + $warning= "not a plain file or symlink"; last; + } + } + &debug("conffile $file drf $drf warns \`$warning'"); + if ($warning) { + &warn("$arg: possible problem with configuration file $file (= $drf):\n". + " $warning"); + return undef; + } else { + return $drf; + } +} diff --git a/scripts/start-stop-daemon.8 b/scripts/start-stop-daemon.8 new file mode 100644 index 000000000..787072016 --- /dev/null +++ b/scripts/start-stop-daemon.8 @@ -0,0 +1,19 @@ +.\" Hey, Emacs! This is an -*- nroff -*- source file. +.TH START\-STOP\-DAEMON 8 "29th November 1995" "Debian Project" "Debian GNU/Linux" +.SH NAME +start\-stop\-daemon \- Debian package installation tool +.SH DESCRIPTION +.B start\-stop\-daemon +does not have a useful man page. Please do not report this as a bug, +as this has already been done many times. + +Instead, if you are a competent and accurate writer and are willing to +spend the time reading the source code and writing good manpages +please write a better man page than this one. + +Type +.B start\-stop\-daemon \-\-help +for a brief summary of how to use dpkg. + +.SH AUTHOR +Ian Jackson <ijackson@gnu.ai.mit.edu>. diff --git a/scripts/start-stop-daemon.pl b/scripts/start-stop-daemon.pl new file mode 100755 index 000000000..ecfeb8960 --- /dev/null +++ b/scripts/start-stop-daemon.pl @@ -0,0 +1,160 @@ +#!/usr/bin/perl -- + +$version= '0.93.30'; # This line modified by Makefile +sub usageversion { + print(STDERR <<END) +Debian GNU/Linux start-stop-daemon $version. Copyright (C) 1995 +Ian Jackson. This is free software; see the GNU General Public Licence +version 2 or later for copying conditions. There is NO warranty. + +Usage: start-stop-daemon --start | --stop | --version|--help options ... +Options: --test --oknodo --exec <executable> --pidfile <pid-file> + --quiet|--verbose --user <username>|<uid> --name <process-name> + --signal <signal> --startas <pathname> + -- <... all of the rest are arguments to daemon ...> + Be careful - try not to call without --exec. \`start-stop-daemon --stop' + would send a SIGTERM to every process, if it weren't specially prevented. + +Exit status: 0 = done 1 = nothing done (=> 0 if --oknodo) 2 = trouble +END + || &quit("failed to write usage: $!"); +} +sub quit { print STDERR "start-stop-daemon: @_\n"; exit(2); } +sub badusage { print STDERR "start-stop-daemon: @_\n\n"; &usageversion; exit(2); } + +$exitnodo= 1; +$quietmode= 0; +$signal= 15; +undef $operation; +undef $exec; +undef $pidfile; +undef $user; +undef $name; +undef $startas; + +while (@ARGV) { + $_= shift(@ARGV); + last if m/^--$/; + if (!m/^--/) { + &quit("unknown argument \`$_'"); + } elsif (m/^--(help|version)$/) { + &usageversion; exit(0); + } elsif (m/^--test$/) { + $testmode= 1; + } elsif (m/^--quiet$/) { + $quietmode= 1; + } elsif (m/^--verbose$/) { + $quietmode= -1; + } elsif (m/^--oknodo$/) { + $exitnodo= 0; + } elsif (m/^--(start|stop)$/) { + $operation= $1; next; + } elsif (m/^--signal$/) { + $_= shift(@ARGV); m/^\d+$/ || &badusage("--signal takes a numeric argument"); + $signal= $_; + } elsif (m/^--(exec|pidfile|name|startas)$/) { + defined($_= shift(@ARGV)) || &badusage("--$1 takes an argument"); + eval("\$$1= \$_"); + } elsif (m/^--user$/) { + defined($_= shift(@ARGV)) || &badusage("--user takes a username argument"); + if (m/^\d+$/) { + $user= $_; + } else { + (@u= getpwnam($_)) || &quit("user \`$_' not found"); + $user= $u[2]; + } + $userspec= $_; + } else { + &badusage("unknown option \`$_'"); + } +} + +defined($operation) || + &badusage("need --start or --stop"); +defined($exec) || defined($pidfile) || defined($user) || + &badusage("need at least one of --exec, --pidfile or --user"); +$startas= $exec if !defined($startas); +$operation ne 'start' || defined($startas) || + &badusage("--start needs --exec or --startas"); + +if (defined($exec)) { + $exec =~ s,^,./, unless $exec =~ m,^[./],; + (@ve= stat("$exec")) || &quit("unable to stat executable \`$exec': $!"); +} + +@found= (); +if (defined($pidfile)) { + $pidfile =~ s,^,./, unless $pidfile =~ m,^[./],; + if (open(PID,"< $pidfile")) { + $pid= <PID>; + &check($1) if $pid =~ m/^\s*(\d+)\s*$/; + close(PID); + } +} else { + opendir(PROC,"/proc") || &quit("failed to opendir /proc: $!"); + $foundany= 0; + while (defined($pid= readdir(PROC))) { + next unless $pid =~ m/^\d+$/; + $foundany++; &check($pid); + } + $foundany || &quit("nothing in /proc - not mounted ?"); +} + +sub check { + local ($p)= @_; + if (defined($exec)) { + return unless @vp= stat("/proc/$p/exe"); + return unless $vp[0] eq $ve[0] && $vp[1] eq $ve[1]; + } + open(C,"/proc/$p/stat"); + (@vs= stat(C)) || return; + if (defined($user)) { + (close(C), return) unless $vs[4] == $user; + } + if (defined($name)) { + $c= <C>; close(C); + return unless $c =~ m/^$p \(([^\)]*)\) / && $1 eq $name; + } + close(C); + push(@found,$p); +} + +if ($operation eq 'start') { + if (@found) { + print "$exec already running.\n" unless $quietmode>0; + exit($exitnodo); + } + if ($testmode) { + print "would start $startas @ARGV.\n"; + exit(0); + } + print "starting $exec ...\n" if $quietmode<0; + exec($startas,@ARGV); + &quit("unable to start $exec: $!"); +} + +$what= defined($name) ? $name : + defined($exec) ? $exec : + defined($pidfile) ? "process in pidfile \`$pidfile'" : + defined($user) ? "process(es) owned by \`$userspec'" : + &quit("internal error, this is a bug - please report:". + " no name,exec,pidfile,user"); + +if (!@found) { + print "no $what found; none killed.\n" unless $quietmode>0; + exit($exitnodo); +} + +for $pid (@found) { + if ($testmode) { + print "would send signal $signal to $pid.\n"; + } else { + if (kill($signal,$pid)) { + push(@killed,$pid); + } else { + print "start-stop-daemon: warning: failed to kill $pid: $!\n"; # + } + } +} +print "stopped $what (pid @killed).\n" if $quietmode<0; +exit(0); diff --git a/scripts/update-alternatives.8 b/scripts/update-alternatives.8 new file mode 100644 index 000000000..d6719afd9 --- /dev/null +++ b/scripts/update-alternatives.8 @@ -0,0 +1,19 @@ +.\" Hey, Emacs! This is an -*- nroff -*- source file. +.TH UPDATE\-ALTERNATIVES 8 "29th November 1995" "Debian Project" "Debian GNU/Linux" +.SH NAME +update\-alternatives \- Debian package installation tool +.SH DESCRIPTION +.B update\-alternatives +does not have a useful man page. Please do not report this as a bug, +as this has already been done many times. + +Instead, if you are a competent and accurate writer and are willing to +spend the time reading the source code and writing good manpages +please write a better man page than this one. + +Type +.B update\-alternatives \-\-help +for a brief summary of how to use dpkg. + +.SH AUTHOR +Ian Jackson <ijackson@gnu.ai.mit.edu>. diff --git a/scripts/update-alternatives.pl b/scripts/update-alternatives.pl new file mode 100755 index 000000000..a961253dc --- /dev/null +++ b/scripts/update-alternatives.pl @@ -0,0 +1,429 @@ +#!/usr/bin/perl -- + +#use POSIX; &ENOENT; +sub ENOENT { 2; } +# Sorry about this, but POSIX.pm isn't necessarily available + +$version= '0.93.80'; # This line modified by Makefile +sub usageversion { + print(STDERR <<END) +Debian GNU/Linux update-alternatives $version. Copyright (C) 1995 +Ian Jackson. This is free software; see the GNU General Public Licence +version 2 or later for copying conditions. There is NO warranty. + +Usage: update-alternatives --install <link> <name> <path> <priority> + [--slave <link> <name> <path>] ... + update-alternatives --remove <name> <path> + update-alternatives --auto <name> + update-alternatives --display <name> +<name> is the name in /etc/alternatives. +<path> is the name referred to. +<link> is the link pointing to /etc/alternatives/<name>. +<priority> is an integer; options with higher numbers are chosen. + +Options: --verbose|--quiet --test --help --version + --altdir <directory> --admindir <directory> +END + || &quit("failed to write usage: $!"); +} +sub quit { print STDERR "update-alternatives: @_\n"; exit(2); } +sub badusage { print STDERR "update-alternatives: @_\n\n"; &usageversion; exit(2); } + +$altdir= '/etc/alternatives'; +$admindir= '/var/lib/dpkg/alternatives'; +$testmode= 0; +$verbosemode= 0; +$mode=''; +$manual= 'auto'; +$|=1; + +sub checkmanymodes { + return unless $mode; + &badusage("two modes specified: $_ and --$mode"); +} + +while (@ARGV) { + $_= shift(@ARGV); + last if m/^--$/; + if (!m/^--/) { + &quit("unknown argument \`$_'"); + } elsif (m/^--(help|version)$/) { + &usageversion; exit(0); + } elsif (m/^--test$/) { + $testmode= 1; + } elsif (m/^--verbose$/) { + $verbosemode= +1; + } elsif (m/^--quiet$/) { + $verbosemode= -1; + } elsif (m/^--install$/) { + &checkmanymodes; + @ARGV >= 4 || &badusage("--install needs <link> <name> <path> <priority>"); + ($alink,$name,$apath,$apriority,@ARGV) = @ARGV; + $apriority =~ m/^[-+]?\d+/ || &badusage("priority must be an integer"); + $mode= 'install'; + } elsif (m/^--remove$/) { + &checkmanymodes; + @ARGV >= 2 || &badusage("--remove needs <name> <path>"); + ($name,$apath,@ARGV) = @ARGV; + $mode= 'remove'; + } elsif (m/^--(display|auto)$/) { + &checkmanymodes; + @ARGV || &badusage("--$1 needs <name>"); + $mode= $1; + $name= shift(@ARGV); + } elsif (m/^--slave$/) { + @ARGV >= 3 || &badusage("--slave needs <link> <name> <path>"); + ($slink,$sname,$spath,@ARGV) = @ARGV; + defined($aslavelink{$sname}) && &badusage("slave name $sname duplicated"); + $aslavelinkcount{$slink}++ && &badusage("slave link $slink duplicated"); + $aslavelink{$sname}= $slink; + $aslavepath{$sname}= $spath; + } elsif (m/^--altdir$/) { + @ARGV && &badusage("--altdir needs a <directory> argument"); + $altdir= shift(@ARGV); + } elsif (m/^--admindir$/) { + @ARGV && &badusage("--admindir needs a <directory> argument"); + $admindir= shift(@ARGV); + } else { + &badusage("unknown option \`$_'"); + } +} + +defined($aslavelink{$name}) && &badusage("name $name is both primary and slave"); +$aslavelinkcount{$alink} && &badusage("link $link is both primary and slave"); + +$mode || &badusage("need --display, --install, --remove or --auto"); +$mode eq 'install' || !%slavelink || &badusage("--slave only allowed with --install"); + +if (open(AF,"$admindir/$name")) { + $manual= &gl("manflag"); + $manual eq 'auto' || $manual eq 'manual' || &badfmt("manflag"); + $link= &gl("link"); + while (($sname= &gl("sname")) ne '') { + push(@slavenames,$sname); + defined($slavenum{$sname}) && &badfmt("duplicate slave $tsname"); + $slavenum{$sname}= $#slavenames; + $slink= &gl("slink"); + $slink eq $link && &badfmt("slave link same as main link $link"); + $slavelinkcount{$slink}++ && &badfmt("duplicate slave link $slink"); + push(@slavelinks,$slink); + } + while (($version= &gl("version")) ne '') { + defined($versionnum{$version}) && &badfmt("duplicate path $tver"); + push(@versions,$version); + $versionnum{$version}= $i= $#versions; + $priority= &gl("priority"); + $priority =~ m/^[-+]?\d+$/ || &badfmt("priority $version $priority"); + $priorities[$i]= $priority; + for ($j=0; $j<=$#slavenames; $j++) { + $slavepath{$i,$j}= &gl("spath"); + } + } + close(AF); + $dataread=1; +} elsif ($! != &ENOENT) { + &quit("failed to open $admindir/$name: $!"); +} + +if ($mode eq 'display') { + if (!$dataread) { + &pr("No alternatives for $name."); + } else { + &pr("$name - status is $manual."); + if (defined($linkname= readlink("$altdir/$name"))) { + &pr(" link currently points to $linkname"); + } elsif ($! == &ENOENT) { + &pr(" link currently absent"); + } else { + &pr(" link unreadable - $!"); + } + $best= ''; + for ($i=0; $i<=$#versions; $i++) { + if ($best eq '' || $priorities[$i] > $bestpri) { + $best= $versions[$i]; $bestpri= $priorities[$i]; + } + &pr("$versions[$i] - priority $priorities[$i]"); + for ($j=0; $j<=$#slavenames; $j++) { + next unless length($tspath= $slavepath{$i,$j}); + &pr(" slave $slavenames[$j]: $tspath"); + } + } + if ($best eq '') { + &pr("No versions available."); + } else { + &pr("Current \`best' version is $best."); + } + } + exit 0; +} + +$best= ''; +for ($i=0; $i<=$#versions; $i++) { + if ($best eq '' || $priorities[$i] > $bestpri) { + $best= $versions[$i]; $bestpri= $priorities[$i]; + } +} + +if (defined($linkname= readlink("$altdir/$name"))) { + if ($linkname eq $best) { + $state= 'expected'; + } elsif (defined($linkname2= readlink("$altdir/$name.dpkg-tmp"))) { + $state= 'expected-inprogress'; + } else { + $state= 'unexpected'; + } +} elsif ($! == &ENOENT) { + $state= 'nonexistent'; +} else { + $state= 'unexpected'; +} + +# Possible values for: +# $manual manual, auto +# $state expected, expected-inprogress, unexpected, nonexistent +# $mode auto, install, remove +# all independent + +if ($mode eq 'auto') { + &pr("Setting up automatic selection of $name."); + unlink("$altdir/$name.dpkg-tmp") || $! == &ENOENT || + &quit("unable to remove $altdir/$name.dpkg-tmp: $!"); + unlink("$altdir/$name") || $! == &ENOENT || + &quit("unable to remove $altdir/$name.dpkg-tmp: $!"); + $state= 'nonexistent'; + $manual= 'auto'; +} elsif ($state eq 'nonexistent') { + if ($mode eq 'manual') { + &pr("$altdir/$name has been deleted, returning to automatic selection."); + $mode= 'auto'; + } +} + +# $manual manual, auto +# $state expected, expected-inprogress, unexpected, nonexistent +# $mode auto, install, remove +# mode=auto <=> state=nonexistent + +if ($state eq 'unexpected' && $manual eq 'auto') { + &pr("$altdir/$name has been changed (manually or by a script).\n". + "Switching to manual updates only."); + $manual= 'manual'; +} + +# $manual manual, auto +# $state expected, expected-inprogress, unexpected, nonexistent +# $mode auto, install, remove +# mode=auto <=> state=nonexistent +# state=unexpected => manual=manual + +&pr("Checking available versions of $name, updating links in $altdir ...\n". + "(You may modify the symlinks there yourself if desired - see \`man ln'.)"); + +if ($mode eq 'install') { + if ($link ne $alink && $link ne '') { + &pr("Renaming $name link from $link to $alink."); + rename($link,$alink) || $! == &ENOENT || + &quit("unable to rename $link to $alink: $!"); + } + $link= $alink; + if (!defined($i= $versionnum{$apath})) { + push(@versions,$apath); + $versionnum{$apath}= $i= $#versions; + } + $priorities[$i]= $apriority; + for $sname (keys %aslavelink) { + if (!defined($j= $slavenum{$sname})) { + push(@slavenames,$sname); + $slavenum{$sname}= $j= $#slavenames; + } + $oldslavelink= $slavelinks[$j]; + $newslavelink= $aslavelink{$sname}; + $slavelinkcount{$oldslavelink}-- if $oldslavelink ne ''; + $slavelinkcount{$newslavelink}++ && + &quit("slave link name $newslavelink duplicated"); + if ($newslavelink ne $oldslavelink && $oldslavelink ne '') { + &pr("Renaming $sname slave link from $oldslavelink to $newslavelink."); + rename($oldslavelink,$newslavelink) || $! == &ENOENT || + &quit("unable to rename $oldslavelink to $newslavelink: $!"); + } + $slavelinks[$j]= $newslavelink; + } + for ($j=0; $j<=$#slavenames; $j++) { + $slavepath{$i,$j}= $aslavepath{$slavenames[$j]}; + } +} + +if ($mode eq 'remove') { + if (defined($i= $versionnum{$apath})) { + $k= $#versions; + $versionnum{$versions[$k]}= $i; + delete $versionnum{$versions[$i]}; + $versions[$i]= $versions[$k]; $#versions--; + $priorities[$i]= $priorities[$k]; $#priorities--; + for ($j=0; $j<=$#slavenames; $j++) { + $slavepath{$i,$j}= $slavepath{$k,$j}; + delete $slavepath{$k,$j}; + } + } else { + &pr("Alternative $apath for $name not registered, not removing."); + } +} + +for ($j=0; $j<=$#slavenames; $j++) { + for ($i=0; $i<=$#versions; $i++) { + last if $slavepath{$i,$j} ne ''; + } + if ($i > $#versions) { + &pr("Discarding obsolete slave link $slavenames[$j] ($slavelinks[$j])."); + unlink("$altdir/$slavenames[$j]") || $! == &ENOENT || + &quit("unable to remove $slavenames[$j]: $!"); + unlink($slavelinks[$j]) || $! == &ENOENT || + &quit("unable to remove $slavelinks[$j]: $!"); + $k= $#slavenames; + $slavenum{$slavenames[$k]}= $j; + delete $slavenum{$slavenames[$j]}; + $slavelinkcount{$slavelinks[$j]}--; + $slavenames[$j]= $slavenames[$k]; $#slavenames--; + $slavelinks[$j]= $slavelinks[$k]; $#slavelinks--; + for ($i=0; $i<=$#versions; $i++) { + $slavepath{$i,$j}= $slavepath{$i,$k}; + delete $slavepath{$i,$k}; + } + $j--; + } +} + +if ($manual eq 'manual') { + &pr("Automatic updates of $altdir/$name are disabled, leaving it alone."); + &pr("To return to automatic updates use \`update-alternatives --auto $name'."); +} else { + if ($state eq 'expected-inprogress') { + &pr("Recovering from previous failed update of $name ..."); + rename("$altdir/$name.dpkg-tmp","$altdir/$name") || + &quit("unable to rename $altdir/$name.dpkg-tmp to $altdir/$name: $!"); + $state= 'expected'; + } +} + +# $manual manual, auto +# $state expected, expected-inprogress, unexpected, nonexistent +# $mode auto, install, remove +# mode=auto <=> state=nonexistent +# state=unexpected => manual=manual +# manual=auto => state!=expected-inprogress && state!=unexpected + +open(AF,">$admindir/$name.dpkg-new") || + &quit("unable to open $admindir/$name.dpkg-new for write: $!"); +&paf($manual); +&paf($link); +for ($j=0; $j<=$#slavenames; $j++) { + &paf($slavenames[$j]); + &paf($slavelinks[$j]); +} +&paf(''); +$best= ''; +for ($i=0; $i<=$#versions; $i++) { + if ($best eq '' || $priorities[$i] > $bestpri) { + $best= $versions[$i]; $bestpri= $priorities[$i]; $bestnum= $i; + } + &paf($versions[$i]); + &paf($priorities[$i]); + for ($j=0; $j<=$#slavenames; $j++) { + &paf($slavepath{$i,$j}); + } +} +&paf(''); +close(AF) || &quit("unable to close $admindir/$name.dpkg-new: $!"); + +if ($manual eq 'auto') { + if ($best eq '') { + &pr("Last package providing $name ($link) removed, deleting it."); + unlink("$altdir/$name") || $! == &ENOENT || + &quit("unable to remove $altdir/$name: $!"); + unlink("$link") || $! == &ENOENT || + &quit("unable to remove $altdir/$name: $!"); + unlink("$admindir/$name.dpkg-new") || + &quit("unable to remove $admindir/$name.dpkg-new: $!"); + unlink("$admindir/$name") || $! == &ENOENT || + &quit("unable to remove $admindir/$name: $!"); + exit(0); + } else { + if (!defined($linkname= readlink($link)) && $! != &ENOENT) { + &pr("warning: $link is supposed to be a symlink to $altdir/$name\n". + " (or nonexistent); however, readlink failed: $!"); + } elsif ($linkname ne "$altdir/$name") { + unlink("$link.dpkg-tmp") || $! == &ENOENT || + &quit("unable to ensure $link.dpkg-tmp nonexistent: $!"); + symlink("$altdir/$name","$link.dpkg-tmp") || + &quit("unable to make $link.dpkg-tmp a symlink to $altdir/$name: $!"); + rename("$link.dpkg-tmp",$link) || + &quit("unable to install $link.dpkg-tmp as $link: $!"); + } + if (defined($linkname= readlink("$altdir/$name")) && $linkname eq $best) { + &pr("Leaving $name ($link) pointing to $best."); + } else { + &pr("Updating $name ($link) to point to $best."); + } + unlink("$altdir/$name.dpkg-tmp") || $! == &ENOENT || + &quit("unable to ensure $altdir/$name.dpkg-tmp nonexistent: $!"); + symlink($best,"$altdir/$name.dpkg-tmp"); + } +} + +rename("$admindir/$name.dpkg-new","$admindir/$name") || + &quit("unable to rename $admindir/$name.dpkg-new to $admindir/$name: $!"); + +if ($manual eq 'auto') { + rename("$altdir/$name.dpkg-tmp","$altdir/$name") || + &quit("unable to install $altdir/$name.dpkg-tmp as $altdir/$name"); + for ($j=0; $j<=$#slavenames; $j++) { + $sname= $slavenames[$j]; + $slink= $slavelinks[$j]; + if (!defined($linkname= readlink($slink)) && $! != &ENOENT) { + &pr("warning: $slink is supposed to be a slave symlink to\n". + " $altdir/$sname, or nonexistent; however, readlink failed: $!"); + } elsif ($linkname ne "$altdir/$sname") { + unlink("$slink.dpkg-tmp") || $! == &ENOENT || + &quit("unable to ensure $slink.dpkg-tmp nonexistent: $!"); + symlink("$altdir/$sname","$slink.dpkg-tmp") || + &quit("unable to make $slink.dpkg-tmp a symlink to $altdir/$sname: $!"); + rename("$slink.dpkg-tmp",$slink) || + &quit("unable to install $slink.dpkg-tmp as $slink: $!"); + } + $spath= $slavepath{$bestnum,$j}; + unlink("$altdir/$sname.dpkg-tmp") || $! == &ENOENT || + &quit("unable to ensure $altdir/$sname.dpkg-tmp nonexistent: $!"); + if ($spath eq '') { + &pr("Removing $sname ($slink), not appropriate with $best."); + unlink("$altdir/$sname") || $! == &ENOENT || + &quit("unable to remove $altdir/$sname: $!"); + } else { + if (defined($linkname= readlink("$altdir/$sname")) && $linkname eq $spath) { + &pr("Leaving $sname ($slink) pointing to $spath."); + } else { + &pr("Updating $sname ($slink) to point to $spath."); + } + symlink("$spath","$altdir/$sname.dpkg-tmp") || + &quit("unable to make $altdir/$sname.dpkg-tmp a symlink to $spath: $!"); + rename("$altdir/$sname.dpkg-tmp","$altdir/$sname") || + &quit("unable to install $altdir/$sname.dpkg-tmp as $altdir/$sname: $!"); + } + } +} + +sub pr { print(STDOUT "@_\n") || &quit("error writing stdout: $!"); } +sub paf { + $_[0] =~ m/\n/ && &quit("newlines prohibited in update-alternatives files ($_[0])"); + print(AF "$_[0]\n") || &quit("error writing stdout: $!"); +} +sub gl { + $!=0; $_= <AF>; + length($_) || &quit("error or eof reading $admindir/$name for $_[0] ($!)"); + s/\n$// || &badfmt("missing newline after $_[0]"); + $_; +} +sub badfmt { + &quit("internal error: $admindir/$name corrupt: $_[0]"); +} + +exit(0); diff --git a/scripts/update-rc.d.8 b/scripts/update-rc.d.8 new file mode 100644 index 000000000..3ed3d9049 --- /dev/null +++ b/scripts/update-rc.d.8 @@ -0,0 +1,79 @@ +.\" Hey, Emacs! This is an -*- nroff -*- source file. +.TH UPDATE\-RC.D 8 "29th November 1995" "Debian Project" "Debian/GNU Linux" +.SH NAME +update\-rc.d \- install and remove System-V style init script links +.SH SYNOPSIS +.B update\-rc.d +.I <basename> +\&remove +.LP +.B update-rc.d +.I <basename> +\&defaults +.RI [ " <codenumber> " | " <startcodenumber>" " " "<stopcodenumber> " ] +.LP +.B update-rc.d +.I <basename> +\&start | stop +.I <codenumber> <runlevel> +.RI [ " <runlevel> " [ " <runlevel> " [ ... ]]] +\&. +.SH DESCRIPTION +This manual page explains the Debian +.B "update-rc.d" +System-V init script link utility. It should be used when installing and +removing init scripts on a Debian system. + +.SH REMOVING SCRIPTS +When invoked with the +.I remove +option, update-rc.d removes the script and links to the script for the package +.RI "" <basename> . +It first finds and removes the script in +.B /etc/init.d/ +and then removes all links to the script in +.RB "" /etc/rc[0123456].d/ . + +.SH INSTALLING SCRIPTS +When run with either the +.RI "" defaults ", " start ", or " stop +options, update-rc.d makes links pointing to the script in +.RB "" /etc/init.d/ . +The script must be installed before update-rc.d is run. +The +.I <codenumber> +arguments specify the order in which the script will be executed. +When +.B init +changes runlevels it executes the scripts in the order of their +.I codenumber +from lowest to highest. + +The +.I <runlevel> +arguments specify the runlevels that the script will be run in. +As many as seven runlevels (0-6) may be specified. +The last runlevel must be followed by a period. + +When invoked with the +.I defaults +option the start runlevels are +.B 2 3 4 5 +and the stop runlevels are +.RB "" "0 1 2 3 4 5 6" . +If neither +.I <codenumber> +or +.I <startcodenumber> +and +.I <stopcodenumber> +are specified, then the stop and start codenumbers default to 20. + +.SH FILES +.B /etc/init.d/ +.bl +.B /etc/rc[0123456].d/ + +.SH "SEE ALSO" +.BR init (1), +.BR inittab (1), diff --git a/scripts/update-rc.d.sh b/scripts/update-rc.d.sh new file mode 100755 index 000000000..d471cc177 --- /dev/null +++ b/scripts/update-rc.d.sh @@ -0,0 +1,104 @@ +#!/bin/sh +# +# Usage: +# update-rc.d <basename> remove +# update-rc.d <basename> [options] +# Options are: +# start <codenumber> <runlevel> <runlevel> <runlevel> . +# stop <codenumber> <runlevel> <runlevel> <runlevel> . +# defaults [<codenumber> | <startcode> <stopcode>] +# (means start <startcode> 2 3 4 5 +# as well as stop <stopcode> 0 1 2 3 4 5 6 +# <codenumber> defaults to 20) + +set -e +cd /etc + +initd='init.d' + +usage () { echo >&2 "\ +update-rc.d: error: $1. +usage: update-rc.d <basename> remove + update-rc.d <basename> defaults [<cn> | <scn> <kcn>] + update-rc.d <basename> start|stop <cn> <r> <r> . ..."; exit 1 } + +getinode () { + inode="`ls -Li1 \"$1\" | sed -e 's/^ *//; s/ .*//'`" +} + +if [ $# -lt 2 ]; then usage "too few arguments"; fi +bn="$1"; shift + +if [ xremove = "x$1" ]; then + if [ $# != 1 ]; then usage "remove must be only action"; fi + if [ -f "$initd/$bn" ]; then + echo >&2 "update-rc.d: error: /etc/$initd/$bn exists during rc.d purge." + exit 1 + fi + echo " Removing any system startup links to /etc/$initd/$bn ..." + trap 'rm -f "$initd/$bn"' 0 + touch "$initd/$bn" + getinode "$initd/$bn" + own="$inode" + for f in rc?.d/[SK]*; do + getinode "$f" + if [ "x$inode" = "x$own" ]; then + rm "$f"; + echo " $f" + fi + done + exit 0 +elif [ xdefaults = "x$1" ]; then + if [ $# = 1 ]; then sn=20; kn=20; + elif [ $# = 2 ]; then sn="$2"; kn="$2"; + elif [ $# = 3 ]; then sn="$2"; kn="$3"; + else usage "defaults takes only one or two codenumbers"; fi + set start "$sn" 2 3 4 5 . stop "$kn" 0 1 6 . +elif ! [ xstart = "x$1" -o xstop = "x$1" ]; then + usage "unknown mode or add action $1" +fi + +if ! [ -f "$initd/$bn" ]; then + echo >&2 "update-rc.d: warning /etc/$initd/$bn doesn't exist during rc.d setup." + exit 0 +fi + +getinode "$initd/$bn" +own="$inode" +for f in rc?.d/[SK]*; do + getinode "$f" + if [ "x$inode" = "x$own" ]; then + echo " System startup links pointing to /etc/$initd/$bn already exist." + exit 0 + fi +done + +echo " Adding system startup links pointing to /etc/$initd/$bn ..." +while [ $# -ge 3 ]; do + if [ xstart = "x$1" ]; then ks=S + elif [ xstop = "x$1" ]; then ks=K + else usage "unknown action $1"; fi + number="$2" + shift; shift + while [ $# -ge 1 ]; do + case "$1" in + .) + break + ;; + ?) + ln -s "../$initd/$bn" "rc$1.d/$ks$number$bn" + echo " rc$1.d/$ks$number$bn -> ../$initd/$bn" + shift + continue + ;; + esac + usage 'runlevel is more than one character (forgotten . ?)' + done + shift +done + +if [ $# != 0 ]; then + usage "surplus arguments, but not enough for an add action: $*" +fi + +exit 0 |