From 6077d258b500b20e1e705f5cda567400240c7804 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sat, 27 Apr 2024 11:36:25 +0200 Subject: Adding upstream version 2.21.3+deb11u1. Signed-off-by: Daniel Baumann --- scripts/Makefile | 163 ++ scripts/annotate-output.1 | 59 + scripts/annotate-output.sh | 105 + scripts/archpath.1 | 63 + scripts/archpath.sh | 46 + scripts/bts.bash_completion | 319 +++ scripts/bts.pl | 4367 +++++++++++++++++++++++++++++++ scripts/build-rdeps.pl | 551 ++++ scripts/chdist.bash_completion | 60 + scripts/chdist.pl | 780 ++++++ scripts/checkbashisms.1 | 71 + scripts/checkbashisms.bash_completion | 28 + scripts/checkbashisms.pl | 816 ++++++ scripts/cowpoke.1 | 388 +++ scripts/cowpoke.sh | 547 ++++ scripts/cvs-debc.1 | 67 + scripts/cvs-debi.1 | 71 + scripts/cvs-debi.sh | 370 +++ scripts/cvs-debrelease.1 | 72 + scripts/cvs-debrelease.sh | 385 +++ scripts/cvs-debuild.1 | 59 + scripts/cvs-debuild.pl | 216 ++ scripts/dcmd.1 | 112 + scripts/dcmd.sh | 329 +++ scripts/dd-list.1 | 110 + scripts/dd-list.pl | 322 +++ scripts/deb-reversion.dbk | 320 +++ scripts/deb-reversion.sh | 240 ++ scripts/deb-why-removed.pl | 251 ++ scripts/debbisect | 1143 ++++++++ scripts/debc.1 | 131 + scripts/debc.pl | 1 + scripts/debchange.1 | 491 ++++ scripts/debchange.bash_completion | 90 + scripts/debchange.pl | 1883 +++++++++++++ scripts/debcheckout.pl | 1311 ++++++++++ scripts/debclean.1 | 115 + scripts/debclean.sh | 218 ++ scripts/debcommit.pl | 953 +++++++ scripts/debdiff-apply | 332 +++ scripts/debdiff-apply.1 | 112 + scripts/debdiff.1 | 251 ++ scripts/debdiff.bash_completion | 153 ++ scripts/debdiff.pl | 1215 +++++++++ scripts/debi.1 | 140 + scripts/debi.bash_completion | 23 + scripts/debi.pl | 477 ++++ scripts/debpkg-wrapper.c | 17 + scripts/debpkg.1 | 25 + scripts/debpkg.pl | 95 + scripts/debrebuild.pl | 1280 +++++++++ scripts/debrelease.1 | 138 + scripts/debrelease.sh | 341 +++ scripts/debrepro.pod | 158 ++ scripts/debrepro.sh | 255 ++ scripts/debrsign.1 | 72 + scripts/debrsign.sh | 273 ++ scripts/debsign.1 | 146 ++ scripts/debsign.bash_completion | 42 + scripts/debsign.sh | 869 ++++++ scripts/debsnap.1 | 160 ++ scripts/debsnap.pl | 423 +++ scripts/debuild.1 | 462 ++++ scripts/debuild.bash_completion | 103 + scripts/debuild.pl | 1227 +++++++++ scripts/dep3changelog.1 | 29 + scripts/dep3changelog.pl | 187 ++ scripts/desktop2menu.pl | 317 +++ scripts/devscripts/control.py | 93 + scripts/devscripts/logger.py | 75 + scripts/devscripts/test/__init__.py | 64 + scripts/devscripts/test/pylint.conf | 59 + scripts/devscripts/test/test_flake8.py | 53 + scripts/devscripts/test/test_help.py | 76 + scripts/devscripts/test/test_logger.py | 57 + scripts/devscripts/test/test_pylint.py | 75 + scripts/dget.pl | 742 ++++++ scripts/diff2patches.1 | 50 + scripts/diff2patches.sh | 93 + scripts/dpkg-depcheck.1 | 130 + scripts/dpkg-depcheck.pl | 533 ++++ scripts/dpkg-genbuilddeps.1 | 40 + scripts/dpkg-genbuilddeps.sh | 41 + scripts/dscextract.1 | 33 + scripts/dscextract.bash_completion | 34 + scripts/dscextract.sh | 119 + scripts/dscverify.1 | 86 + scripts/dscverify.bash_completion | 32 + scripts/dscverify.pl | 457 ++++ scripts/edit-patch.sh | 308 +++ scripts/getbuildlog.1 | 42 + scripts/getbuildlog.sh | 151 ++ scripts/git-deborig.pl | 284 ++ scripts/grep-excuses.1 | 62 + scripts/grep-excuses.pl | 411 +++ scripts/hardening-check.pl | 680 +++++ scripts/list-unreleased.1 | 23 + scripts/list-unreleased.bash_completion | 13 + scripts/list-unreleased.sh | 92 + scripts/ltnu.pod | 108 + scripts/ltnu.sh | 86 + scripts/manpage-alert.1 | 35 + scripts/manpage-alert.sh | 147 ++ scripts/mass-bug.pl | 570 ++++ scripts/mergechanges.1 | 33 + scripts/mergechanges.sh | 402 +++ scripts/mk-build-deps.pl | 607 +++++ scripts/mk-origtargz.bash_completion | 49 + scripts/mk-origtargz.pl | 222 ++ scripts/namecheck.pl | 231 ++ scripts/nmudiff.1 | 129 + scripts/nmudiff.sh | 464 ++++ scripts/origtargz.pl | 438 ++++ scripts/pkgnames.bash_completion | 24 + scripts/plotchangelog.1 | 127 + scripts/plotchangelog.bash_completion | 33 + scripts/plotchangelog.pl | 429 +++ scripts/pts-subscribe.1 | 59 + scripts/pts-subscribe.sh | 176 ++ scripts/rc-alert.1 | 129 + scripts/rc-alert.pl | 501 ++++ scripts/reproducible-check | 266 ++ scripts/rmadison.pl | 409 +++ scripts/run_bisect.sh | 90 + scripts/run_bisect_qemu.sh | 344 +++ scripts/sadt | 596 +++++ scripts/sadt.pod | 71 + scripts/salsa.bash_completion | 51 + scripts/salsa.pl | 885 +++++++ scripts/setup.py | 42 + scripts/suspicious-source | 154 ++ scripts/svnpath.pl | 100 + scripts/tagpending.pl | 437 ++++ scripts/transition-check.pl | 241 ++ scripts/uscan.bash_completion | 59 + scripts/uscan.pl | 2210 ++++++++++++++++ scripts/uupdate.1 | 199 ++ scripts/uupdate.bash_completion | 47 + scripts/uupdate.sh | 1142 ++++++++ scripts/what-patch.bash_completion | 13 + scripts/what-patch.sh | 121 + scripts/who-permits-upload.pl | 349 +++ scripts/who-uploads.1 | 76 + scripts/who-uploads.sh | 266 ++ scripts/whodepends.1 | 20 + scripts/whodepends.sh | 56 + scripts/wnpp-alert.1 | 34 + scripts/wnpp-alert.sh | 139 + scripts/wnpp-check.1 | 42 + scripts/wnpp-check.sh | 101 + scripts/wrap-and-sort | 320 +++ 151 files changed, 45832 insertions(+) create mode 100644 scripts/Makefile create mode 100644 scripts/annotate-output.1 create mode 100755 scripts/annotate-output.sh create mode 100644 scripts/archpath.1 create mode 100755 scripts/archpath.sh create mode 100644 scripts/bts.bash_completion create mode 100755 scripts/bts.pl create mode 100755 scripts/build-rdeps.pl create mode 100644 scripts/chdist.bash_completion create mode 100755 scripts/chdist.pl create mode 100644 scripts/checkbashisms.1 create mode 100644 scripts/checkbashisms.bash_completion create mode 100755 scripts/checkbashisms.pl create mode 100644 scripts/cowpoke.1 create mode 100755 scripts/cowpoke.sh create mode 100644 scripts/cvs-debc.1 create mode 100644 scripts/cvs-debi.1 create mode 100755 scripts/cvs-debi.sh create mode 100644 scripts/cvs-debrelease.1 create mode 100755 scripts/cvs-debrelease.sh create mode 100644 scripts/cvs-debuild.1 create mode 100755 scripts/cvs-debuild.pl create mode 100644 scripts/dcmd.1 create mode 100755 scripts/dcmd.sh create mode 100644 scripts/dd-list.1 create mode 100755 scripts/dd-list.pl create mode 100644 scripts/deb-reversion.dbk create mode 100755 scripts/deb-reversion.sh create mode 100755 scripts/deb-why-removed.pl create mode 100755 scripts/debbisect create mode 100644 scripts/debc.1 create mode 120000 scripts/debc.pl create mode 100644 scripts/debchange.1 create mode 100644 scripts/debchange.bash_completion create mode 100755 scripts/debchange.pl create mode 100755 scripts/debcheckout.pl create mode 100644 scripts/debclean.1 create mode 100755 scripts/debclean.sh create mode 100755 scripts/debcommit.pl create mode 100755 scripts/debdiff-apply create mode 100644 scripts/debdiff-apply.1 create mode 100644 scripts/debdiff.1 create mode 100644 scripts/debdiff.bash_completion create mode 100755 scripts/debdiff.pl create mode 100644 scripts/debi.1 create mode 100644 scripts/debi.bash_completion create mode 100755 scripts/debi.pl create mode 100644 scripts/debpkg-wrapper.c create mode 100644 scripts/debpkg.1 create mode 100755 scripts/debpkg.pl create mode 100755 scripts/debrebuild.pl create mode 100644 scripts/debrelease.1 create mode 100755 scripts/debrelease.sh create mode 100644 scripts/debrepro.pod create mode 100755 scripts/debrepro.sh create mode 100644 scripts/debrsign.1 create mode 100755 scripts/debrsign.sh create mode 100644 scripts/debsign.1 create mode 100644 scripts/debsign.bash_completion create mode 100755 scripts/debsign.sh create mode 100644 scripts/debsnap.1 create mode 100755 scripts/debsnap.pl create mode 100644 scripts/debuild.1 create mode 100644 scripts/debuild.bash_completion create mode 100755 scripts/debuild.pl create mode 100644 scripts/dep3changelog.1 create mode 100755 scripts/dep3changelog.pl create mode 100755 scripts/desktop2menu.pl create mode 100644 scripts/devscripts/control.py create mode 100644 scripts/devscripts/logger.py create mode 100644 scripts/devscripts/test/__init__.py create mode 100644 scripts/devscripts/test/pylint.conf create mode 100644 scripts/devscripts/test/test_flake8.py create mode 100644 scripts/devscripts/test/test_help.py create mode 100644 scripts/devscripts/test/test_logger.py create mode 100644 scripts/devscripts/test/test_pylint.py create mode 100755 scripts/dget.pl create mode 100644 scripts/diff2patches.1 create mode 100755 scripts/diff2patches.sh create mode 100644 scripts/dpkg-depcheck.1 create mode 100755 scripts/dpkg-depcheck.pl create mode 100644 scripts/dpkg-genbuilddeps.1 create mode 100755 scripts/dpkg-genbuilddeps.sh create mode 100644 scripts/dscextract.1 create mode 100644 scripts/dscextract.bash_completion create mode 100755 scripts/dscextract.sh create mode 100644 scripts/dscverify.1 create mode 100644 scripts/dscverify.bash_completion create mode 100755 scripts/dscverify.pl create mode 100755 scripts/edit-patch.sh create mode 100644 scripts/getbuildlog.1 create mode 100755 scripts/getbuildlog.sh create mode 100755 scripts/git-deborig.pl create mode 100644 scripts/grep-excuses.1 create mode 100755 scripts/grep-excuses.pl create mode 100755 scripts/hardening-check.pl create mode 100644 scripts/list-unreleased.1 create mode 100644 scripts/list-unreleased.bash_completion create mode 100755 scripts/list-unreleased.sh create mode 100644 scripts/ltnu.pod create mode 100755 scripts/ltnu.sh create mode 100644 scripts/manpage-alert.1 create mode 100755 scripts/manpage-alert.sh create mode 100755 scripts/mass-bug.pl create mode 100644 scripts/mergechanges.1 create mode 100755 scripts/mergechanges.sh create mode 100755 scripts/mk-build-deps.pl create mode 100644 scripts/mk-origtargz.bash_completion create mode 100755 scripts/mk-origtargz.pl create mode 100755 scripts/namecheck.pl create mode 100644 scripts/nmudiff.1 create mode 100755 scripts/nmudiff.sh create mode 100755 scripts/origtargz.pl create mode 100644 scripts/pkgnames.bash_completion create mode 100644 scripts/plotchangelog.1 create mode 100644 scripts/plotchangelog.bash_completion create mode 100755 scripts/plotchangelog.pl create mode 100644 scripts/pts-subscribe.1 create mode 100755 scripts/pts-subscribe.sh create mode 100644 scripts/rc-alert.1 create mode 100755 scripts/rc-alert.pl create mode 100755 scripts/reproducible-check create mode 100755 scripts/rmadison.pl create mode 100755 scripts/run_bisect.sh create mode 100755 scripts/run_bisect_qemu.sh create mode 100755 scripts/sadt create mode 100644 scripts/sadt.pod create mode 100644 scripts/salsa.bash_completion create mode 100755 scripts/salsa.pl create mode 100755 scripts/setup.py create mode 100755 scripts/suspicious-source create mode 100755 scripts/svnpath.pl create mode 100755 scripts/tagpending.pl create mode 100755 scripts/transition-check.pl create mode 100644 scripts/uscan.bash_completion create mode 100755 scripts/uscan.pl create mode 100644 scripts/uupdate.1 create mode 100644 scripts/uupdate.bash_completion create mode 100755 scripts/uupdate.sh create mode 100644 scripts/what-patch.bash_completion create mode 100755 scripts/what-patch.sh create mode 100755 scripts/who-permits-upload.pl create mode 100644 scripts/who-uploads.1 create mode 100755 scripts/who-uploads.sh create mode 100644 scripts/whodepends.1 create mode 100755 scripts/whodepends.sh create mode 100644 scripts/wnpp-alert.1 create mode 100755 scripts/wnpp-alert.sh create mode 100644 scripts/wnpp-check.1 create mode 100755 scripts/wnpp-check.sh create mode 100755 scripts/wrap-and-sort (limited to 'scripts') diff --git a/scripts/Makefile b/scripts/Makefile new file mode 100644 index 0000000..bb41c31 --- /dev/null +++ b/scripts/Makefile @@ -0,0 +1,163 @@ + +include ../Makefile.common +include /usr/share/dpkg/vendor.mk +DESTDIR = + +define \n + + +endef + +VERSION_FILE = ../version +VERSION = $(shell cat $(VERSION_FILE)) + +PL_FILES := $(wildcard *.pl) +SH_FILES = $(wildcard *.sh) +CWRAPPERS = debpkg-wrapper +SCRIPTS = $(patsubst %.pl,%,$(PL_FILES)) $(patsubst %.sh,%,$(SH_FILES)) +PL_CHECKS = $(patsubst %.pl,%.pl_check,$(PL_FILES)) +SH_CHECKS = $(patsubst %.sh,%.sh_check,$(SH_FILES)) +COMPL_FILES := $(wildcard *.bash_completion) +BC_BUILD_DIR:=bash_completion +COMPLETION = $(patsubst %.bash_completion,$(BC_BUILD_DIR)/%,$(COMPL_FILES)) +COMPL_DIR := $(shell pkg-config --variable=completionsdir bash-completion) +PKGNAMES := \ + build-rdeps \ + dd-list \ + debcheckout \ + debsnap \ + dget \ + getbuildlog \ + grep-excuses \ + mass-bug \ + mk-build-deps \ + pts-subscribe \ + pts-unsubscribe \ + rc-alert \ + rmadison \ + transition-check \ + who-uploads \ + whodepends \ + wnpp-alert \ + wnpp-check \ + +GEN_MAN1S += \ + deb-why-removed.1 \ + debbisect.1 \ + debrebuild.1 \ + debrepro.1 \ + ltnu.1 \ + mk-origtargz.1 \ + salsa.1 \ + reproducible-check.1 \ + uscan.1 \ + +all: $(SCRIPTS) $(GEN_MAN1S) $(CWRAPPERS) $(COMPLETION) + +scripts: $(SCRIPTS) + +$(VERSION_FILE): + $(MAKE) -C .. version + +%: %.sh + +debchange: debchange.pl $(VERSION_FILE) + cp $< $@ + sed -i "s/###VERSION###/$(VERSION)/" $@ +ifeq ($(DEB_VENDOR),Ubuntu) +# On Ubuntu always default to targeting the release that it's built on, +# not the current devel release, since its primary use on stable releases +# will be for preparing PPA uploads. + sed -i 's/get_ubuntu_devel_distro()/"$(shell lsb_release -cs)"/' $@ +endif + +%.tmp: %.sh $(VERSION_FILE) + sed -e "s/###VERSION###/$(VERSION)/" $< > $@ +%.tmp: %.pl $(VERSION_FILE) + sed -e "s/###VERSION###/$(VERSION)/" $< > $@ +%: %.tmp + cp $< $@ + chmod +x $@ + +%.1: %.pl + podchecker $< + pod2man --utf8 --center=" " --release="Debian Utilities" $< > $@ +%.1: %.pod + podchecker $< + pod2man --utf8 --center=" " --release="Debian Utilities" $< > $@ +%.1: %.dbk + xsltproc --nonet -o $@ \ + /usr/share/sgml/docbook/stylesheet/xsl/nwalsh/manpages/docbook.xsl $< + +# Syntax checker +test_sh: $(SH_CHECKS) +%.sh_check: % + bash -n $< + +test_pl: $(PL_CHECKS) +%.pl_check: % + perl -I ../lib -c $<; \ + +test_py: $(VERSION_FILE) + $(foreach python,$(shell py3versions -r ../debian/control),$(python) setup.py test$(\n)) + +debbisect.1: debbisect + help2man \ + --name="bisect snapshot.debian.org" \ + --version-string=$(VERSION) \ + --no-info \ + --no-discard-stderr \ + ./$< >$@ + +debrebuild.1: debrebuild + help2man \ + --name="use a buildinfo file and snapshot.d.o to recreate binary packages" \ + --version-string=$(VERSION) \ + --no-info \ + --no-discard-stderr \ + ./$< >$@ + +reproducible-check.1: reproducible-check + help2man \ + --name="Reports on the reproducible status of installed packages" \ + --no-info \ + --no-discard-stderr \ + ./$< >$@ + +$(BC_BUILD_DIR): + mkdir $(BC_BUILD_DIR) + +$(COMPLETION): $(BC_BUILD_DIR)/% : %.bash_completion $(BC_BUILD_DIR) + cp $< $@ + +clean: + python3 setup.py clean -a + find -name '*.pyc' -delete + find -name __pycache__ -delete + rm -rf devscripts.egg-info $(BC_BUILD_DIR) .pylint.d + rm -f $(SCRIPTS) $(patsubst %,%.tmp,$(SCRIPTS)) \ + $(GEN_MAN1S) $(SCRIPT_LIBS) $(CWRAPPERS) + + +test: test_pl test_sh test_py + +install: all + python3 setup.py install --root="$(DESTDIR)" --no-compile --install-layout=deb + cp $(SCRIPTS) $(DESTDIR)$(BINDIR) + ln -sf edit-patch $(DESTDIR)$(BINDIR)/add-patch + install -d $(DESTDIR)$(COMPL_DIR) + cp $(BC_BUILD_DIR)/* $(DESTDIR)$(COMPL_DIR)/ + for i in $(PKGNAMES); do \ + ln -sf pkgnames $(DESTDIR)$(COMPL_DIR)/$$i; \ + done + ln -sf debchange $(DESTDIR)$(COMPL_DIR)/dch + ln -sf debi $(DESTDIR)$(COMPL_DIR)/debc + # Special treatment for debpkg and run_bisect + install -d $(DESTDIR)$(DATA_DIR) + mv $(DESTDIR)$(BINDIR)/debpkg $(DESTDIR)$(DATA_DIR) + cp debpkg-wrapper $(DESTDIR)$(BINDIR)/debpkg + install -d $(DESTDIR)$(DATA_DIR)/scripts + mv $(DESTDIR)$(BINDIR)/run_bisect $(DESTDIR)$(DATA_DIR)/scripts + mv $(DESTDIR)$(BINDIR)/run_bisect_qemu $(DESTDIR)$(DATA_DIR)/scripts + +.PHONY: test test_pl test_sh test_py all install clean scripts diff --git a/scripts/annotate-output.1 b/scripts/annotate-output.1 new file mode 100644 index 0000000..f2fec00 --- /dev/null +++ b/scripts/annotate-output.1 @@ -0,0 +1,59 @@ +.TH ANNOTATE-OUTPUT 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +annotate-output \- annotate program output with time and stream +.SH SYNOPSIS +\fBannotate\-output\fR [\fIoptions\fR] \fIprogram\fR [\fIargs\fR ...] +.SH DESCRIPTION +\fBannotate\-output\fR will execute the specified program, while +prepending every line with the current time and O for stdout and E for +stderr. + +.SH OPTIONS +.TP +\fB+FORMAT\fR +Controls the timestamp format, as per \fBdate\fR(1). Defaults to +"%H:%M:%S". +.TP +\fB\-h\fR, \fB\-\-help\fR +Display a help message and exit successfully. + +.SH EXAMPLE + +.nf +$ annotate-output make +21:41:21 I: Started make +21:41:21 O: gcc \-Wall program.c +21:43:18 E: program.c: Couldn't compile, and took me ages to find out +21:43:19 E: collect2: ld returned 1 exit status +21:43:19 E: make: *** [all] Error 1 +21:43:19 I: Finished with exitcode 2 +.fi + +.SH BUGS +Since stdout and stderr are processed in parallel, it can happen that +some lines received on stdout will show up before later-printed stderr +lines (and vice-versa). + +This is unfortunately very hard to fix with the current annotation +strategy. A fix would involve switching to PTRACE'ing the process. +Giving nice a (much) higher priority over the executed program could +however cause this behaviour to show up less frequently. + +The program does not work as well when the output is not linewise. In +particular, when an interactive program asks for input, the question +might not be shown until after you have answered it. This will give +the impression that the annotated program has hung, while it has not. + +.SH "SEE ALSO" +\fBdate\fR(1) + +.SH SUPPORT +This program is community-supported (meaning: you'll need to fix it +yourself). Patches are however appreciated, as is any feedback +(positive or negative). + +.SH AUTHOR +\fBannotate-output\fR was written by Jeroen van Wolffelaar +. This manpage comes under the same copyright as +annotate-output itself, read /usr/bin/annotate-output (or wherever +you install it) for the details. diff --git a/scripts/annotate-output.sh b/scripts/annotate-output.sh new file mode 100755 index 0000000..6929faa --- /dev/null +++ b/scripts/annotate-output.sh @@ -0,0 +1,105 @@ +#!/bin/bash +# this script was downloaded from: +# https://jeroen.a-eskwadraat.nl/sw/annotate +# and is part of devscripts ###VERSION### + +# Executes a program annotating the output linewise with time and stream +# Version 1.2 + +# Copyright 2003, 2004 Jeroen van Wolffelaar + +# This program 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; version 2 of the License +# +# This program 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 this program. If not, see . + +progname=$(basename $0) + +addtime () +{ + while IFS= read -r line; do + printf "%s %s: %s\n" "$(date "${FMT}")" "$1" "$line" + done + if [ ! -z "$line" ]; then + printf "%s %s: %s" "$(date "${FMT}")" "$1" "$line" + fi +} + +addprefix () +{ + while IFS= read -r line; do + printf "%s: %s\n" "$1" "$line" + done + if [ ! -z "$line" ]; then + printf "%s: %s" "$1" "$line" + fi +} + +usage () +{ + echo \ +"Usage: $progname [options] program [args ...] + Run program and annotate STDOUT/STDERR with a timestamp. + + Options: + +FORMAT - Controls the timestamp format as per date(1) + -h, --help - Show this message" +} + +FMT="+%H:%M:%S" +while [ "$1" ]; do + case "$1" in + +*) + FMT="$1" + shift + ;; + -h|-help|--help) + usage + exit 0 + ;; + *) + break + ;; + esac +done + +if [ $# -lt 1 ]; then + usage + exit 1 +fi + +cleanup() { __st=$?; rm -rf "$tmp"; exit $__st; } +trap cleanup 0 +trap 'exit $?' 1 2 13 15 + +tmp=$(mktemp -d --tmpdir annotate.XXXXXX) || exit 1 +OUT=$tmp/out +ERR=$tmp/err + +mkfifo $OUT $ERR || exit 1 + +if [ "${FMT/\%}" != "${FMT}" ] ; then + addtime O < $OUT & + addtime E < $ERR & +else + # If FMT does not contain a %, use the optimized version that + # does not call 'date'. + addprefix "${FMT#+} O" < $OUT & + addprefix "${FMT#+} E" < $ERR & +fi + +echo "Started $@" | addtime I +"$@" > $OUT 2> $ERR ; EXIT=$? +rm -f $OUT $ERR +wait + +echo "Finished with exitcode $EXIT" | addtime I + +exit $EXIT diff --git a/scripts/archpath.1 b/scripts/archpath.1 new file mode 100644 index 0000000..6425645 --- /dev/null +++ b/scripts/archpath.1 @@ -0,0 +1,63 @@ +.TH ARCHPATH 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +archpath \- output arch (tla/Bazaar) archive names, with support for branches +.SH SYNOPSIS +.B archpath +.br +.B archpath +.I branch +.br +.B archpath +.IR branch \fB--\fI version +.SH DESCRIPTION +.B archpath +is intended to be run in an arch (tla or Bazaar) working copy. +.PP +In its simplest usage, +.B archpath +with no parameters outputs the package name +(archive/category--branch--version) associated with the working copy. +.PP +If a parameter is given, it may either be a branch--version, in which case +.B archpath +will output a corresponding package name in the current archive and +category, or a plain branch name (without \(oq--\(dq), in which case +.B archpath +will output a corresponding package name in the current archive and +category and with the same version as the current working copy. +.PP +This is useful for branching. +For example, if you're using Bazaar and you want to create a branch for a +new feature, you might use a command like this: +.PP +.RS +.nf +.ft CW +baz branch $(archpath) $(archpath new-feature) +.ft R +.fi +.RE +.PP +Or if you want to tag your current code onto a \(oqreleases\(cq branch as +version 1.0, you might use a command like this: +.PP +.RS +.nf +.ft CW +baz branch $(archpath) $(archpath releases--1.0) +.ft R +.fi +.RE +.PP +That's much easier than using \(oqbaz tree-version\(cq to look up the +package name and manually modifying the result. +.SH AUTHOR +.B archpath +was written by +.na +Colin Watson . +.ad +Like +.BR archpath , +this manual page is released under the GNU General Public License, +version 2 or later. diff --git a/scripts/archpath.sh b/scripts/archpath.sh new file mode 100755 index 0000000..ff6ba61 --- /dev/null +++ b/scripts/archpath.sh @@ -0,0 +1,46 @@ +#!/bin/bash + +# Output arch (tla/Bazaar) archive names, with support for branches + +# Copyright (C) 2005 Colin Watson + +# This program 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 program 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 this program. If not, see . + +set -e + +# Which arch implementation should we use? +if type baz >/dev/null 2>&1; then + PROGRAM=baz +else + PROGRAM=tla +fi + +WANTED="$1" +ME="$($PROGRAM tree-version)" + +if [ "$WANTED" ]; then + ARCHIVE="$($PROGRAM parse-package-name --arch "$ME")" + CATEGORY="$($PROGRAM parse-package-name --category "$ME")" + case $WANTED in + *--*) + echo "$ARCHIVE/$CATEGORY--$WANTED" + ;; + *) + VERSION="$($PROGRAM parse-package-name --vsn "$ME")" + echo "$ARCHIVE/$CATEGORY--$WANTED--$VERSION" + ;; + esac +else + echo "$ME" +fi diff --git a/scripts/bts.bash_completion b/scripts/bts.bash_completion new file mode 100644 index 0000000..c5f6288 --- /dev/null +++ b/scripts/bts.bash_completion @@ -0,0 +1,319 @@ +# /usr/share/bash-completion/completions/bts +# Bash command completion for ‘bts(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +# Copyright © 2015, Nicholas Bamber + +_get_version_from_package() +{ + local _pkg=$1 + [[ -n $_pkg ]] || return + apt-cache madison $_pkg 2> /dev/null | cut -d'|' -f2 | sort | uniq | paste -s -d' ' +} + +# This works really well unless someone sets up nasty firewall rules like: +# sudo iptables -A OUTPUT -d 206.12.19.140 -j DROP +# sudo iptables -A OUTPUT -d 140.211.166.26 -j DROP +# These block access to the Debian bugs SOAP interface. +# Hence we need a timeout. +# Of course if the SOAP interface is blocked then so is the caching interface. +# So really this would only affect someone who only accidentally hit the TAB key. +_get_version_from_bug() +{ + local -i _bug=$1 + _get_version_from_package $( bts --soap-timeout=2 status $_bug fields:package 2> /dev/null | cut -f2 ) +} + +_suggest_packages() +{ + apt-cache --no-generate pkgnames "$1" 2> /dev/null +} + +_suggest_bugs() +{ + bts --offline listcachedbugs "$1" 2> /dev/null +} + +_bts() +{ + local cur prev words cword + _init_completion -n = || return + + # Note: + # The long lists of subcommands are not the same and not necessarily to be kept in sync. + # The first is used to suggest commands after a '.' or ','. + # The second is to hook in special handling (which may be as little as admitting we + # we can't handle it further) or the default special handling (list of bug ids). + # This also includes "by" and "with" which are not even subcommands. + # The third is similar to the first - what to suggest after the bts command (and options). + # but this includes the "help" and "version" commands. + + # A sequence of bts commands can be on one command line separated by "." or ",". + if [[ $prev == @(.|,) ]]; then + COMPREPLY=( $( compgen -W 'show bugs unmerge select status clone done reopen archive unarchive retitle summary submitter reassign found notfound fixed notfixed block unblock merge forcemerge tags affects user usertags claim unclaim severity forwarded notforwarded package limit owner noowner subscribe unsubscribe reportspam spamreport' -- "$cur" ) ) + return 0 + fi + + # Identify the last command in the command line. + local special punctuation i + for (( i=${#words[@]}-1; i > 0; i-- )); do + if [[ ${words[i]} == @(show|bugs|select|limit|unmerge|status|clone|done|reopen|archive|unarchive|retitle|summary|submitter|reassign|found|notfound|fixed|notfixed|block|unblock|merge|forcemerge|tags|affects|user|usertags|claim|unclaim|severity|forwarded|notforwarded|package|owner|noowner|subscribe|unsubscribe|reportspam|spamreport|cache|cleancache|by|with) ]]; then + special=${words[i]} + break + fi + if [[ ${words[i]} == @(+|-|=) ]]; then + punctuation=${words[i]} + fi + done + + if [[ -n $special ]]; then + + # The command separator must be surrounded by white space. + if [[ "$cur" == @(,|.) ]]; then + COMPREPLY=( $cur ) + return 0 + fi + + case $special in + show|bugs) + # bugs/show supports a few limited options + # but as args we accept bug ids, package names and release-critical + if [[ "$cur" == -* ]]; then + COMPREPLY=( $( compgen -W '-o --offline --online -m --mbox \ + --no-cache --cache' -- "$cur" ) ) + elif [[ "$cur" == release-critical/* ]]; then + local _pkg=${cur#release-critical/} + COMPREPLY=( $( _suggest_packages "$_pkg" | sed -e's!^!release-critical/!' ) ) + else + COMPREPLY=( $( compgen -W 'release-critical RC' -- "$cur" ) \ + $( _suggest_bugs "$cur" ) \ + $( _suggest_packages "$cur" ) ) + fi + return 0 + ;; + status) + # we accept "verbose" and bug ids + COMPREPLY=( $( compgen -W 'verbose' -- "$cur" ) \ + $( _suggest_bugs "$cur" ) ) + return 0 + ;; + clone) + # we accept 1 bug id and then generate new clone ids + if [[ "$prev" == +([0-9]) ]]; then + COMPREPLY=( $( compgen -W '-1' -- "$cur" ) ) + elif [[ "$prev" == -+([0-9]) ]]; then + local -i j + (( j=$prev-1 )) + COMPREPLY=( $( compgen -W $j -- "$cur" ) ) + else + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + fi + return 0 + ;; + done|found|notfound|fixed|notfixed) + # Try to guess the version + if [[ "$prev" == +([0-9]) ]]; then + local _versions=$( _get_version_from_bug $prev ) + if [[ -n $_versions ]]; then + COMPREPLY=( $( compgen -W $_versions -- "$cur" ) ) + else + COMPREPLY=( ) + fi + else + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + fi + return 0 + ;; + reopen|claim|unclaim|owner|subscribe|unsubscribe) + if [[ "$prev" == +([0-9]) && -n $DEBEMAIL ]]; then + COMPREPLY=( $( compgen -W $DEBEMAIL -- "$cur" ) ) + else + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + fi + return 0 + ;; + reassign) + # Must have at least one bug id. + # Once we have a package name, all that remains is an optional version. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ "$prev" == +([0-9]) ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) \ + $( _suggest_packages "$cur" ) ) + else + local _versions=$( _get_version_from_package $prev ) + COMPREPLY=( $( compgen -W $_versions -- "$cur" ) ) + fi + return 0 + ;; + block|unblock) + # Must have at least one bug id. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ "$prev" == +([0-9]) ]]; then + COMPREPLY=( $( compgen -W 'by with' -- "$cur" ) ) + else + COMPREPLY=( ) + fi + return 0 + ;; + unmerge|forwarded|notforwarded|noowner) + # Must have at most one bug id. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + else + COMPREPLY=( ) + fi + return 0 + ;; + tags) + # Must have one bug id. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ -n $punctuation ]]; then + # The official list is mirrored + # https://www.debian.org/Bugs/server-control#tag + # in the variable @gTags; we copy it verbatim here. + COMPREPLY=( $( compgen -W 'patch wontfix moreinfo unreproducible fixed potato woody sid help security upstream pending sarge sarge-ignore experimental d-i confirmed ipv6 lfs fixed-in-experimental fixed-upstream l10n newcomer a11y ftbfs etch etch-ignore lenny lenny-ignore squeeze squeeze-ignore wheezy wheezy-ignore jessie jessie-ignore stretch stretch-ignore buster buster-ignore bullseye bullseye-ignore' -- "$cur" ) ) + else + COMPREPLY=() + COMPREPLY[0]='= ' + COMPREPLY[1]='+ ' + COMPREPLY[2]='- ' + fi + return 0 + ;; + affects) + # Must have one bug id. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ -n $punctuation ]]; then + COMPREPLY=( $( _suggest_packages "$cur" ) ) + else + COMPREPLY=() + COMPREPLY[0]='= ' + COMPREPLY[1]='+ ' + COMPREPLY[2]='- ' + fi + return 0 + ;; + user) + if [[ "$prev" == $special && -n $DEBEMAIL ]]; then + COMPREPLY=( $( compgen -W $DEBEMAIL -- "$cur" ) ) + else + COMPREPLY=( ) + fi + return 0 + ;; + usertags) + # Must have one bug id. + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ -z $punctuation ]]; then + COMPREPLY=() + COMPREPLY[0]='= ' + COMPREPLY[1]='+ ' + COMPREPLY[2]='- ' + else + COMPREPLY=() + fi + return 0 + ;; + severity) + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + elif [[ "$prev" == +([0-9]) ]]; then + COMPREPLY=( $( compgen -W 'wishlist minor normal important serious \ + grave critical' -- "$cur" ) ) + else + COMPREPLY=() + fi + return 0 + ;; + select|limit) + # can't handle ":". Give up for now. + COMPREPLY=( ) + return 0 + ;; + package) + COMPREPLY=( $( _suggest_packages "$cur" ) ) + return 0 + ;; + cache) + # cache supports a few limited options + # but as args we accept bug ids, package names and release-critical + if [[ "$prev" == --cache-mode ]]; then + COMPREPLY=( $( compgen -W 'min mbox full' -- "$cur" ) ) + elif [[ "$cur" == release-critical/* ]]; then + local _pkg=${cur#release-critical/} + COMPREPLY=( $( _suggest_packages "$_pkg" | sed -e's!^!release-critical/!' ) ) + elif [[ "$cur" == -* ]]; then + COMPREPLY=( $( compgen -W '--cache-mode --force-refresh -f \ + --include-resolved -q --quiet' -- "$cur" ) ) + else + COMPREPLY=( $( compgen -W 'release-critical RC' -- "$cur" ) \ + $( _suggest_packages "$cur" ) ) + fi + return 0 + ;; + cleancache) + if [[ "$prev" == $special ]]; then + COMPREPLY=( $( compgen -W 'ALL' -- "$cur" ) \ + $( _suggest_bugs "$cur" ) \ + $( _suggest_packages "$cur" ) ) + else + COMPREPLY=( ) + fi + return 0 + ;; + *) + COMPREPLY=( $( _suggest_bugs "$cur" ) ) + return 0 + ;; + esac + fi + + case $prev in + --cache-mode) + COMPREPLY=( $( compgen -W 'min mbox full' -- "$cur" ) ) + return 0 + ;; + --cache-delay) + COMPREPLY=( $( compgen -W '5 60 120 240 600' -- "$cur" ) ) + return 0 + ;; + esac + + if [[ "$cur" == -* ]]; then + COMPREPLY=( $( compgen -W '-o --offline --online -n --no-action --cache --no-cache --cache-mode --cache-delay --mbox --no-use-default-cc --mutt --no-mutt -f --force-refresh --no-force-refresh --only-new --include-resolved --no-include-resolved --no-ack --ack -i --interactive --force-interactivei --no-interactive -q --quiet' -- "$cur" ) ) + else + COMPREPLY=( $( compgen -W 'show bugs unmerge select status clone done reopen archive unarchive retitle summary submitter reassign found notfound fixed notfixed block unblock merge forcemerge tags affects user usertags claim unclaim severity forwarded notforwarded package limit owner noowner subscribe unsubscribe reportspam spamreport cache cleancache version help' -- "$cur" ) ) + fi + + # !!! not handled !!! + # --mailreader=READER + # --cc-addr=CC_EMAIL_ADDRESS + # --use-default-cc + # --sendmail=SENDMAILCMD + # --smtp-host=SMTPHOST + # --smtp-username=USERNAME + # --smtp-password=PASSWORD + # --smtp-helo=HELO + # --bts-server + # --no-conf, --noconf + # + # anything with colons for now + # for similar reasons having issues with tags XXXX = + # no special handling for select + + return 0 +} && +complete -F _bts bts + + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/bts.pl b/scripts/bts.pl new file mode 100755 index 0000000..f5c1539 --- /dev/null +++ b/scripts/bts.pl @@ -0,0 +1,4367 @@ +#!/usr/bin/perl + +# bts: This program provides a convenient interface to the Debian +# Bug Tracking System. +# +# Written by Joey Hess +# Modifications by Julian Gilbey +# Modifications by Josh Triplett +# Copyright 2001-2003 Joey Hess +# Modifications Copyright 2001-2003 Julian Gilbey +# Modifications Copyright 2007 Josh Triplett +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +# Use our own subclass of Pod::Text to +# a) Strip the POD markup before displaying it via "bts help" +# b) Automatically display the text which is supposed to be replaced by the +# user between <>, as per convention. +package Pod::BTS; +use strict; + +use base qw(Pod::Text); + +sub cmd_i { return '<' . $_[2] . '>' } + +package main; + +=head1 NAME + +bts - developers' command line interface to the Debian Bug Tracking System + +=cut + +use 5.010; # for defined-or +use strict; +use warnings; +use File::Basename; +use File::Copy; +use File::HomeDir; +use File::Path qw(make_path rmtree); +use File::Spec; +use File::Temp qw/tempfile/; +use Net::SMTP; +use Cwd; +use IO::File; +use IO::Handle; +use Devscripts::DB_File_Lock; +use Devscripts::Debbugs; +use Fcntl qw(O_RDWR O_RDONLY O_CREAT F_SETFD); +use Getopt::Long; +use Encode; +# Need support for ; as query param separator +use URI 1.37; +use URI::QueryParam; + +use Scalar::Util qw(looks_like_number); +use POSIX qw(locale_h strftime); + +setlocale(LC_TIME, "C"); # so that strftime is locale independent + +# Funny UTF-8 warning messages from HTML::Parse should be ignorable (#292671) +$SIG{'__WARN__'} = sub { + warn $_[0] + unless $_[0] + =~ /^Parsing of undecoded UTF-8 will give garbage when decoding entities/; +}; + +my $it = undef; +my $last_user = ''; +my $lwp_broken = undef; +my $smtps_broken = undef; +my $authen_sasl_broken; +my $ua; + +sub have_lwp() { + return ($lwp_broken ? 0 : 1) if defined $lwp_broken; + eval { + require LWP; + require LWP::UserAgent; + require HTTP::Status; + require HTTP::Date; + }; + + if ($@) { + if ($@ =~ m%^Can\'t locate LWP%) { + $lwp_broken = "the libwww-perl package is not installed"; + } else { + $lwp_broken = "couldn't load LWP::UserAgent: $@"; + } + } else { + $lwp_broken = ''; + } + return $lwp_broken ? 0 : 1; +} + +sub have_smtps() { + return ($smtps_broken ? 0 : 1) if defined $smtps_broken; + eval { require Net::SMTPS; }; + + if ($@) { + if ($@ =~ m%^Can\'t locate Net/SMTPS%) { + $smtps_broken = "the libnet-smtps-perl package is not installed"; + } else { + $smtps_broken = "couldn't load Net::SMTPS: $@"; + } + } else { + $smtps_broken = ''; + } + return $smtps_broken ? 0 : 1; +} + +sub have_authen_sasl() { + return ($authen_sasl_broken ? 0 : 1) if defined $authen_sasl_broken; + eval { require Authen::SASL; }; + + if ($@) { + if ($@ =~ m%^Can't locate Authen/SASL%) { + $authen_sasl_broken + = 'the libauthen-sasl-perl package is not installed'; + } else { + $authen_sasl_broken = "couldn't load Authen::SASL: $@"; + } + } else { + $authen_sasl_broken = ''; + } + return $authen_sasl_broken ? 0 : 1; +} + +# Constants +sub MIRROR_ERROR { 0; } +sub MIRROR_DOWNLOADED { 1; } +sub MIRROR_UP_TO_DATE { 2; } +my $NONPRINT = "\\x00-\\x1F\\x7F-\\xFF"; # we need this later for MIME stuff + +my $progname = basename($0); +my $modified_conf_msg; +my $debug = (exists $ENV{'DEBUG'} and $ENV{'DEBUG'}) ? 1 : 0; + +# Program version handling +# The BTS changed its format :/ Pages downloaded using old versions +# of bts won't look very good, so we force updating if the last cached +# version was downloaded by a devscripts version less than +# $new_cache_format_version +my $version = '###VERSION###'; +$version = '2.9.6' if $version =~ /\#/; # for testing unconfigured version +my $new_cache_format_version = '2.9.6'; + +# The official list is mirrored +# bugs-mirror.debian.org:/srv/bugs.debian.org/etc/config +# in the variable @gTags; we copy it verbatim here. +# +# Note that it is also in the POD documentation in the bts_tag +# function below, look for "potato". +our (@gTags, @valid_tags, %valid_tags); +#<<< This variable definition should be kept verbatim from the BTS config +@gTags = ( "patch", "wontfix", "moreinfo", "unreproducible", + "help", "security", "upstream", "pending", "confirmed", + "ipv6", "lfs", "d-i", "l10n", "newcomer", "a11y", "ftbfs", + "fixed-upstream", "fixed", "fixed-in-experimental", + "sid", "experimental", + "potato", "woody", + "sarge", "sarge-ignore", "etch", "etch-ignore", + "lenny", "lenny-ignore", "squeeze", "squeeze-ignore", + "wheezy", "wheezy-ignore", "jessie", "jessie-ignore", + "stretch", "stretch-ignore", "buster", "buster-ignore", + "bullseye", "bullseye-ignore","bookworm","bookworm-ignore", + ); +#>>> + +*valid_tags = \@gTags; +%valid_tags = map { $_ => 1 } @valid_tags; +my @valid_severities = qw(wishlist minor normal important + serious grave critical); + +my $browser; # Will set if necessary + +$ENV{HOME} = File::HomeDir->my_home; +my $cachedir + = $ENV{XDG_CACHE_HOME} || File::Spec->catdir($ENV{HOME}, '.cache'); +$cachedir = File::Spec->catdir($cachedir, 'devscripts', 'bts'); + +my $timestampdb = File::Spec->catfile($cachedir, 'bts_timestamps.db'); +my $prunestamp = File::Spec->catfile($cachedir, 'bts_prune.timestamp'); + +my %timestamp; + +END { + # This works even if we haven't tied it + untie %timestamp; +} + +my %clonedbugs = (); +my %ccpackages = (); +my %ccsubmitters = (); + +=head1 SYNOPSIS + +B [I] I [I] [B<#>I] [B<.>|B<,> I [I] [B<#>I]] ... + +=head1 DESCRIPTION + +This is a command line interface to the Debian Bug Tracking System +(BTS), intended mainly +for use by developers. It lets the BTS be manipulated using simple commands +that can be run at the prompt or in a script, does various sanity checks on +the input, and constructs and sends a mail to the BTS control address for +you. A local cache of web pages and e-mails from the BTS may also be +created and updated. + +In general, the command line interface is the same as what you would write +in a mail to control@bugs.debian.org, just prefixed with "bts". For +example: + + % bts severity 69042 normal + % bts merge 69042 43233 + % bts retitle 69042 blah blah + +A few additional commands have been added for your convenience, and this +program is less strict about what constitutes a valid bug number. For example, +"severity Bug#85942 normal" is understood, as is "severity #85942 normal". +(Of course, your shell may regard "#" as a comment character though, so you +may need to quote it!) + +Also, for your convenience, this program allows you to abbreviate commands +to the shortest unique substring (similar to how cvs lets you abbreviate +commands). So it understands things like "bts cl 85942". + +It is also possible to include a comment in the mail sent to the BTS. If +your shell does not strip out the comment in a command like +"bts severity 30321 normal #inflated severity", then this program is smart +enough to figure out where the comment is, and include it in the email. +Note that most shells do strip out such comments before they get to the +program, unless the comment is quoted. (Something like "bts +severity #85942 normal" will not be treated as a comment!) + +You can specify multiple commands by separating them with a single dot, +rather like B; a single comma may also be used; all the +commands will then be sent in a single mail. It is important the dot/comma is +surrounded by whitespace so it is not mistaken for part of a command. For +example (quoting where necessary so that B sees the comment): + + % bts severity 95672 normal , merge 95672 95673 \#they are the same! + +The abbreviation "it" may be used to refer to the last mentioned bug +number, so you could write: + + % bts severity 95672 wishlist , retitle it "bts: please add a --foo option" + +Please use this program responsibly, and do take our users into +consideration. + +=head1 OPTIONS + +B examines the B configuration files as described +below. Command line options override the configuration file settings, +though. + +=over 4 + +=item B<-o>, B<--offline> + +Make B use cached bugs for the B and B commands, if a cache +is available for the requested data. See the B command, below for +information on setting up a cache. + +=item B<--online>, B<--no-offline> + +Opposite of B<--offline>; overrides any configuration file directive to work +offline. + +=item B<-n>, B<--no-action> + +Do not send emails but print them to standard output. + +=item B<--cache>, B<--no-cache> + +Should we attempt to cache new versions of BTS pages when +performing B/B commands? Default is to cache. + +=item B<--cache-mode=>{B|B|B} + +When running a B command, should we only mirror the basic +bug (B), or should we also mirror the mbox version (B), or should +we mirror the whole thing, including the mbox and the boring +attachments to the BTS bug pages and the acknowledgement emails (B)? +Default is B. + +=item B<--cache-delay=>I + +Time in seconds to delay between each download, to avoid hammering the BTS +web server. Default is 5 seconds. + +=item B<--mbox> + +Open a mail reader to read the mbox corresponding to a given bug number +for B and B commands. + +=item B<--mailreader=>I + +Specify the command to read the mbox. Must contain a "B<%s>" string +(unquoted!), which will be replaced by the name of the mbox file. The +command will be split on white space and will not be passed to a +shell. Default is 'B'. (Also, B<%%> will be substituted by a +single B<%> if this is needed.) + +=item B<--cc-addr=>I + +Send carbon copies to a list of users. I should be a +comma-separated list of email addresses. + +=item B<--use-default-cc> + +Add the addresses specified in the configuration file option +B to the list specified using B<--cc-addr>. This is the +default. + +=item B<--no-use-default-cc> + +Do not add addresses specified in B to the carbon copy +list. + +=item B<--sendmail=>I + +Specify the B command. The command will be split on white +space and will not be passed to a shell. Default is +F. The B<-t> option will be automatically added if +the command is F or F. For other +mailers, if they require a B<-t> option, this must be included in the +I, for example: B<--sendmail="/usr/sbin/mymailer -t">. + +=item B<--mutt> + +Use B for sending of mails. Default is not to use B, except for some +commands. + +Note that one of B<$DEBEMAIL> or B<$EMAIL> must be set in the environment in order +to use B to send emails. + +=item B<--no-mutt> + +Don't use B for sending of mails. + +=item B<--soap-timeout=>I + +Specify a timeout for SOAP calls as used by the B [IB<:>I ...] + +Uses the SOAP interface to output a list of bugs which match the given +selection requirements. + +The following keys are allowed, and may be given multiple times. + +=over 8 + +=item B + +Binary package name. + +=item B + +Source package name. + +=item B + +E-mail address of the maintainer. + +=item B + +E-mail address of the submitter. + +=item B + +Bug severity. + +=item B + +Status of the bug. One of B, B, or B. + +=item B + +Tags applied to the bug. If B is specified, may include +usertags in addition to the standard tags. + +=item B + +Bug's owner. + +=item B + +Address of someone who sent mail to the log. + +=item B + +Bugs which affect this package. + +=item B + +List of bugs to search within. + +=item B + +Users to use when looking up usertags. + +=item B + +Whether to search archived bugs or normal bugs; defaults to B<0> +(i.e. only search normal bugs). As a special case, if archive is +B, both archived and unarchived bugs are returned. + +=back + +For example, to select the set of bugs submitted by +jrandomdeveloper@example.com and tagged B, one would use + +bts select submitter:jrandomdeveloper@example.com tag:wontfix + +If a key is used multiple times then the set of bugs selected includes +those matching any of the supplied values; for example + +bts select package:foo severity:wishlist severity:minor + +returns all bugs of package foo with either wishlist or minor severity. + +=cut + +sub bts_select { + my @args = @_; + my $bugs = Devscripts::Debbugs::select(@args); + if (not defined $bugs) { + die "Error while retrieving bugs from SOAP server"; + } + print map { qq($_\n) } @{$bugs}; +} + +=item B [I | BI | BI[B<,>I ...] | B] ... + +Uses the SOAP interface to output status information for the given bugs +(or as read from the listed files -- use B<-> to indicate STDIN). + +By default, all populated fields for a bug are displayed. + +If B is given, empty fields will also be displayed. + +If B is given, only those fields will be displayed. No validity +checking is performed on any specified fields. + +=cut + +sub bts_status { + my @args = @_; + + my @bugs; + my $showempty = 0; + my %field; + for my $bug (@args) { + if (looks_like_number($bug)) { + push @bugs, $bug; + } elsif ($bug =~ m{^file:(.+)}) { + my $file = $1; + my $fh; + if ($file eq '-') { + $fh = \*STDIN; + } else { + $fh = IO::File->new($file, 'r') + or die "Unable to open $file for reading: $!"; + } + while (<$fh>) { + chomp; + next if /^\s*\#/; + s/\s//g; + next unless looks_like_number($_); + push @bugs, $_; + } + } elsif ($bug =~ m{^fields:(.+)}) { + my $fields = $1; + for my $field (split /,/, $fields) { + $field{ lc $field } = 1; + } + $showempty = 1; + } elsif ($bug =~ m{^verbose$}) { + $showempty = 1; + } + } + my $bugs + = Devscripts::Debbugs::status(map { [bug => $_, indicatesource => 1] } + @bugs); + return if ($bugs eq ""); + + my $first = 1; + for my $bug (keys %{$bugs}) { + print "\n" if not $first; + $first = 0; + my @keys = grep { $_ ne 'bug_num' } + keys %{ $bugs->{$bug} }; + for my $key ('bug_num', @keys) { + if (%field) { + next unless exists $field{$key}; + } + my $out; + if (ref($bugs->{$bug}{$key}) eq 'ARRAY') { + $out .= join(',', @{ $bugs->{$bug}{$key} }); + } elsif (ref($bugs->{$bug}{$key}) eq 'HASH') { + $out .= join(',', + map { $_ . ' => ' . ($bugs->{$bug}{$key}{$_} || '') } + keys %{ $bugs->{$bug}{$key} }); + } else { + $out .= $bugs->{$bug}{$key} || ''; + } + if ($out || $showempty) { + print "$key\t$out\n"; + } + } + } +} + +=item B I I [I ...] + +The B control command allows you to duplicate a I report. It is useful +in the case where a single report actually indicates that multiple distinct +bugs have occurred. "New IDs" are negative numbers, separated by spaces, +which may be used in subsequent control commands to refer to the newly +duplicated bugs. A new report is generated for each new ID. + +=cut + +sub bts_clone { + my $bug = checkbug(shift) or die "bts clone: clone what bug?\n"; + @_ or die "bts clone: must specify at least one new ID\n"; + foreach (@_) { + $_ =~ /^-\d+$/ or die "bts clone: new IDs must be negative numbers\n"; + $clonedbugs{$_} = 1; + } + mailbts("cloning $bug", "clone $bug " . join(" ", @_)); +} + +sub common_close { + my $bug = checkbug(shift) or die "bts $command[$index]: close what bug?\n"; + my $version = shift; + $version = "" unless defined $version; + opts_done(@_); + mailbts("closing $bug", "close $bug $version"); + return $bug; +} + +# Do not include this in the manpage - it's deprecated +# +# =item B I I +# +# Close a I. Remember that using this to close a bug is often bad manners, +# sending an informative mail to nnnnn-done@bugs.debian.org is much better. +# You should specify which I of the package closed the I, if +# possible. +# +# =cut + +sub bts_close { + my ($bug) = common_close(@_); + warn <<"EOT"; +$progname: Closing $bug as you requested. +Please note that the "$progname close" command is deprecated! +It is usually better to email nnnnnn-done\@$btsserver with +an informative mail. +Please remember to email $bug-submitter\@$btsserver with +an explanation of why you have closed this bug. Thank you! +EOT +} + +=item B I [I] + +Mark a I as Done. This forces interactive mode since done messages should +include an explanation why the bug is being closed. You should specify which +I of the package closed the bug, if possible. + +=cut + +sub bts_done { + my ($bug) = common_close(@_); + # Force interactive mode since done mails shouldn't be sent without an + # explanation + if (not $use_mutt) { + $interactive = 'force'; + } + + # Include the submitter in the email, so we act like a mail to -done + $ccsubmitters{"$bug-submitter"} = 1; +} + +=item B I [I] + +Reopen a I, with optional I. + +=cut + +sub bts_reopen { + my $bug = checkbug(shift) or die "bts reopen: reopen what bug?\n"; + my $submitter = shift || ''; # optional + opts_done(@_); + mailbts("reopening $bug", "reopen $bug $submitter"); +} + +=item B I + +Archive a I that has previously been archived but is currently not. +The I must fulfill all of the requirements for archiving with the +exception of those that are time-based. + +=cut + +sub bts_archive { + my $bug = checkbug(shift) or die "bts archive: archive what bug?\n"; + opts_done(@_); + mailbts("archiving $bug", "archive $bug"); +} + +=item B I + +Unarchive a I that is currently archived. + +=cut + +sub bts_unarchive { + my $bug = checkbug(shift) or die "bts unarchive: unarchive what bug?\n"; + opts_done(@_); + mailbts("unarchiving $bug", "unarchive $bug"); +} + +=item B I I + +Change the I<title> of the I<bug>. + +=cut + +sub bts_retitle { + my $bug = checkbug(shift) or die "bts retitle: retitle what bug?\n"; + my $title = join(" ", @_); + if (!length $title) { + die "bts retitle: set title of $bug to what?\n"; + } + mailbts("retitle $bug to $title", "retitle $bug $title"); +} + +=item B<summary> I<bug> [I<messagenum>] + +Select a message number that should be used as +the summary of a I<bug>. + +If no message number is given, the summary is cleared. + +=cut + +sub bts_summary { + my $bug = checkbug(shift) + or die "bts summary: change summary of what bug?\n"; + my $msg = shift || ''; + mailbts("summary $bug $msg", "summary $bug $msg"); +} + +=item B<submitter> I<bug> [I<bug> ...] I<submitter-email> + +Change the submitter address of a I<bug> or a number of bugs, with B<!> meaning +`use the address on the current email as the new submitter address'. + +=cut + +sub bts_submitter { + @_ or die "bts submitter: change submitter of what bug?\n"; + my $submitter = checkemail(pop, 1); + if (!defined $submitter) { + die "bts submitter: change submitter to what?\n"; + } + foreach (@_) { + my $bug = checkbug($_) + or die "bts submitter: $_ is not a bug number\n"; + mailbts("submitter $bug", "submitter $bug $submitter"); + } +} + +=item B<reassign> I<bug> [I<bug> ...] I<package> [I<version>] + +Reassign a I<bug> or a number of bugs to a different I<package>. +The I<version> field is optional; see the explanation at +L<https://www.debian.org/Bugs/server-control>. + +=cut + +sub bts_reassign { + my ($bug, @bugs); + while ($_ = shift) { + $bug = checkbug($_, 1) or last; + push @bugs, $bug; + } + @bugs or die "bts reassign: reassign what bug(s)?\n"; + my $package = $_ or die "bts reassign: reassign bug(s) to what package?\n"; + my $version = shift; + $version = "" unless defined $version; + if (length $version and $version !~ /\d/) { + die "bts reassign: version number $version contains no digits!\n"; + } + opts_done(@_); + + foreach $bug (@bugs) { + mailbts("reassign $bug to $package", + "reassign $bug $package $version"); + } + + foreach my $packagename (split /,/, $package) { + $packagename =~ s/^src://; + $ccpackages{$packagename} = 1; + } +} + +=item B<found> I<bug> [I<version>] + +Indicate that a I<bug> was found to exist in a particular package version. +Without I<version>, the list of fixed versions is cleared and the bug is +reopened. + +=cut + +sub bts_found { + my $bug = checkbug(shift) or die "bts found: found what bug?\n"; + my $version = shift; + if (!defined $version) { + warn +"$progname: found has no version number, but sending to the BTS anyway\n"; + $version = ""; + } + opts_done(@_); + mailbts("found $bug in $version", "found $bug $version"); +} + +=item B<notfound> I<bug> I<version> + +Remove the record that I<bug> was encountered in the given version of the +package to which it is assigned. + +=cut + +sub bts_notfound { + my $bug = checkbug(shift) or die "bts notfound: what bug?\n"; + my $version = shift + or die "bts notfound: remove record \#$bug from which version?\n"; + opts_done(@_); + mailbts("notfound $bug in $version", "notfound $bug $version"); +} + +=item B<fixed> I<bug> I<version> + +Indicate that a I<bug> was fixed in a particular package version, without +affecting the I<bug>'s open/closed status. + +=cut + +sub bts_fixed { + my $bug = checkbug(shift) or die "bts fixed: what bug?\n"; + my $version = shift or die "bts fixed: \#$bug fixed in which version?\n"; + opts_done(@_); + mailbts("fixed $bug in $version", "fixed $bug $version"); +} + +=item B<notfixed> I<bug> I<version> + +Remove the record that a I<bug> was fixed in the given version of the +package to which it is assigned. + +This is equivalent to the sequence of commands "B<found> I<bug> I<version>", +"B<notfound> I<bug> I<version>". + +=cut + +sub bts_notfixed { + my $bug = checkbug(shift) or die "bts notfixed: what bug?\n"; + my $version = shift + or die "bts notfixed: remove record \#$bug from which version?\n"; + opts_done(@_); + mailbts("notfixed $bug in $version", "notfixed $bug $version"); +} + +=item B<block> I<bug> B<by>|B<with> I<bug> [I<bug> ...] + +Note that a I<bug> is blocked from being fixed by a set of other bugs. + +=cut + +sub bts_block { + my $bug = checkbug(shift) or die "bts block: what bug is blocked?\n"; + my $word = shift; + if (defined $word && $word ne 'by' && $word ne 'with') { + unshift @_, $word; + } + @_ or die "bts block: need to specify at least two bug numbers\n"; + my @blockers; + foreach (@_) { + my $blocker = checkbug($_) + or die "bts block: some blocking bug number(s) not valid\n"; + push @blockers, $blocker; + } + mailbts("block $bug with @blockers", "block $bug with @blockers"); +} + +=item B<unblock> I<bug> B<by>|B<with> I<bug> [I<bug> ...] + +Note that a I<bug> is no longer blocked from being fixed by a set of other bugs. + +=cut + +sub bts_unblock { + my $bug = checkbug(shift) or die "bts unblock: what bug is blocked?\n"; + my $word = shift; + if (defined $word && $word ne 'by' && $word ne 'with') { + unshift @_, $word; + } + @_ or die "bts unblock: need to specify at least two bug numbers\n"; + my @blockers; + foreach (@_) { + my $blocker = checkbug($_) + or die "bts unblock: some blocking bug number(s) not valid\n"; + push @blockers, $blocker; + } + mailbts("unblock $bug with @blockers", "unblock $bug with @blockers"); +} + +=item B<merge> I<bug> I<bug> [I<bug> ...] + +Merge a set of bugs together. + +=cut + +sub bts_merge { + my @bugs; + foreach (@_) { + my $bug = checkbug($_) + or die "bts merge: some bug number(s) not valid\n"; + push @bugs, $bug; + } + @bugs > 1 + or die + "bts merge: at least two bug numbers to be merged must be specified\n"; + mailbts("merging @bugs", "merge @bugs"); +} + +=item B<forcemerge> I<bug> I<bug> [I<bug> ...] + +Forcibly merge a set of bugs together. The first I<bug> listed is the master bug, +and its settings (those which must be equal in a normal B<merge>) are assigned to +the bugs listed next. + +=cut + +sub bts_forcemerge { + my @bugs; + foreach (@_) { + my $bug = checkbug($_) + or die "bts forcemerge: some bug number(s) not valid\n"; + push @bugs, $bug; + } + @bugs > 1 + or die +"bts forcemerge: at least two bug numbers to be merged must be specified\n"; + mailbts("forcibly merging @bugs", "forcemerge @bugs"); +} + +=item B<unmerge> I<bug> + +Unmerge a I<bug>. + +=cut + +sub bts_unmerge { + my $bug = checkbug(shift) or die "bts unmerge: unmerge what bug?\n"; + opts_done(@_); + mailbts("unmerging $bug", "unmerge $bug"); +} + +=item B<tag> I<bug> [B<+>|B<->|B<=>] I<tag> [I<tag> ...] + +=item B<tags> I<bug> [B<+>|B<->|B<=>] I<tag> [I<tag> ...] + +Set or unset a I<tag> on a I<bug>. The tag may either be the exact tag name +or it may be abbreviated to any unique tag substring. (So using +B<fixed> will set the tag B<fixed>, not B<fixed-upstream>, for example, +but B<fix> would not be acceptable.) Multiple tags may be specified as +well. The two commands (tag and tags) are identical. At least one tag +must be specified, unless the B<=> flag is used, where the command + + bts tags <bug> = + +will remove all tags from the specified I<bug>. + +Adding/removing the B<security> tag will add "team\@security.debian.org" +to the Cc list of the control email. + +The list of valid tags and their significance is available at +L<https://www.debian.org/Bugs/Developer#tags>. The current valid tags +are: + +patch, wontfix, moreinfo, unreproducible, fixed, help, security, upstream, +pending, d-i, confirmed, ipv6, lfs, fixed-upstream, l10n, newcomer, +a11y, ftbfs + +There is also a tag for each release of Debian since "potato". Note +that this list may be out of date, see the website for the most up to +date source. + +=cut + +# note that the tag list is also in the @gtag variable, look for +# "potato" above. +sub bts_tags { + my $bug = checkbug(shift) or die "bts tags: tag what bug?\n"; + if (!@_) { + die "bts tags: set what tag?\n"; + } + # Parse the rest of the command line. + my $base_command = "tags $bug"; + my $commands = []; + + my $curop; + foreach my $tag (@_) { + if ($tag =~ s/^([-+=])//) { + my $op = $1; + if ($op eq '=') { + $curop = '='; + $commands = []; + $ccsecurity = ''; + } elsif (!$curop || $curop ne $op) { + $curop = $op; + } + next unless $tag; + } + if (!$curop) { + $curop = '+'; + } + if ($tag eq 'gift') { + my $gift_flag = $curop; + if ($gift_flag eq '=') { + $gift_flag = '+'; + } + # Backward compatibility: do both gift usertagging and newcomer + # tagging. Gifting should be removed after a suitable migration + # time. See https://wiki.debian.org/qa.debian.org/GiftTag header + # for more info. + mailbts("tagging $bug", "tags $bug + newcomer"); + mailbts( + "gifting $bug", +"user debian-qa\@lists.debian.org\nusertag $bug $gift_flag gift" + ); + next; + } + if (!exists $valid_tags{$tag}) { + # Try prefixes + my @matches = grep /^\Q$tag\E/, @valid_tags; + if (@matches != 1) { + die "bts tags: \"$tag\" is not a " + . (@matches > 1 ? "unique" : "valid") + . " tag prefix. Choose from: " + . join(" ", @valid_tags) . "\n"; + } + $tag = $matches[0]; + } + if (!@$commands || $curop ne $commands->[-1]{op}) { + push(@$commands, { op => $curop, tags => [] }); + } + push(@{ $commands->[-1]{tags} }, $tag); + if ($tag eq "security") { + $ccsecurity = "team\@security.debian.org"; + } + } + + my $command = ''; + foreach my $cmd (@$commands) { + if ($cmd->{op} ne '=' && !@{ $cmd->{tags} }) { + die "bts tags: set what tag?\n"; + } + $command .= " $cmd->{op} " . join(' ', @{ $cmd->{tags} }); + } + if (!$command && $curop eq '=') { + $command = " $curop"; + } + + if ($command) { + mailbts("tagging $bug", $base_command . $command); + } +} + +=item B<affects> I<bug> [B<+>|B<->|B<=>] I<package> [I<package> ...] + +Indicates that a I<bug> affects a I<package> other than that against which it is filed, causing +the I<bug> to be listed by default in the I<package> list of the other I<package>. This should +generally be used where the I<bug> is severe enough to cause multiple reports from users to be +assigned to the wrong package. At least one I<package> must be specified, unless +the B<=> flag is used, where the command + + bts affects <bug> = + +will remove all indications that I<bug> affects other packages. + +=cut + +sub bts_affects { + my $bug = checkbug(shift) + or die "bts affects: mark what bug as affecting another package?\n"; + + if (!@_) { + die "bts affects: mark which package as affected?\n"; + } + # Parse the rest of the command line. + my $command = "affects $bug"; + my $flag = ""; + if ($_[0] =~ /^[-+=]$/) { + $flag = $_[0]; + $command .= " $flag"; + shift; + } elsif ($_[0] =~ s/^([-+=])//) { + $flag = $1; + $command .= " $flag"; + } + + if ($flag ne '=' && !@_) { + die "bts affects: mark which package as affected?\n"; + } + + foreach my $package (@_) { + $command .= " $package"; + } + + mailbts("affects $bug", $command); +} + +=item B<user> I<email> + +Specify a user I<email> address before using the B<usertags> command. + +=cut + +sub bts_user { + my $email = checkemail(shift) + or die "bts user: set user to what email address?\n"; + if (!length $email) { + die "bts user: set user to what email address?\n"; + } + opts_done(@_); + if ($email ne $last_user) { + mailbts("user $email", "user $email"); + } + $last_user = $email; +} + +=item B<usertag> I<bug> [B<+>|B<->|B<=>] I<tag> [I<tag> ...] + +=item B<usertags> I<bug> [B<+>|B<->|B<=>] I<tag> [I<tag> ...] + +Set or unset a user tag on a I<bug>. The I<tag> must be the exact tag name wanted; +there are no defaults or checking of tag names. Multiple tags may be +specified as well. The two commands (B<usertag> and B<usertags>) are identical. +At least one I<tag> must be specified, unless the B<=> flag is used, where the +command + + bts usertags <bug> = + +will remove all user tags from the specified I<bug>. + +=cut + +sub bts_usertags { + my $bug = checkbug(shift) or die "bts usertags: tag what bug?\n"; + if (!@_) { + die "bts usertags: set what user tag?\n"; + } + # Parse the rest of the command line. + my $command = "usertags $bug"; + my $flag = ""; + if ($_[0] =~ /^[-+=]$/) { + $flag = $_[0]; + $command .= " $flag"; + shift; + } elsif ($_[0] =~ s/^([-+=])//) { + $flag = $1; + $command .= " $flag"; + } + + if ($flag ne '=' && !@_) { + die "bts usertags: set what user tag?\n"; + } + + $command .= sprintf(' %s', join(' ', @_)); + + mailbts("usertagging $bug", $command); +} + +=item B<claim> I<bug> [I<claim>] + +Record that you have claimed a I<bug> (e.g. for a bug squashing party). +I<claim> should be a unique token allowing the bugs you have claimed +to be identified; an e-mail address is often used. + +If no I<claim> is specified, the environment variable B<DEBEMAIL> +or B<EMAIL> (checked in that order) is used. + +=cut + +sub bts_claim { + my $bug = checkbug(shift) or die "bts claim: claim what bug?\n"; + my $claim = checkemail(shift) || $ENV{'DEBEMAIL'} || $ENV{'EMAIL'} || ""; + if (!length $claim) { + die "bts claim: use what claim token?\n"; + } + $claim = extractemail($claim); + bts_user("bugsquash\@qa.debian.org"); + bts_usertags("$bug", "+$claim"); +} + +=item B<unclaim> I<bug> [I<claim>] + +Remove the record that you have claimed a bug. + +If no I<claim> is specified, the environment variable B<DEBEMAIL> +or B<EMAIL> (checked in that order) is used. + +=cut + +sub bts_unclaim { + my $bug = checkbug(shift) or die "bts unclaim: unclaim what bug?\n"; + my $claim = checkemail(shift) || $ENV{'DEBEMAIL'} || $ENV{'EMAIL'} || ""; + if (!length $claim) { + die "bts unclaim: use what claim token?\n"; + } + $claim = extractemail($claim); + bts_user("bugsquash\@qa.debian.org"); + bts_usertags("$bug", "-$claim"); +} + +=item B<severity> I<bug> I<severity> + +Change the I<severity> of a I<bug>. Available severities are: B<wishlist>, B<minor>, B<normal>, +B<important>, B<serious>, B<grave>, B<critical>. The severity may be abbreviated to any +unique substring. + +=cut + +sub bts_severity { + my $bug = checkbug(shift) + or die "bts severity: change the severity of what bug?\n"; + my $severity = lc(shift) + or die "bts severity: set \#$bug\'s severity to what?\n"; + my @matches = grep /^\Q$severity\E/i, @valid_severities; + if (@matches != 1) { + die +"bts severity: \"$severity\" is not a valid severity.\nChoose from: @valid_severities\n"; + } + opts_done(@_); + mailbts("severity of $bug is $matches[0]", "severity $bug $matches[0]"); +} + +=item B<forwarded> I<bug> I<address> + +Mark the I<bug> as forwarded to the given I<address> (usually an email address or +a URL for an upstream bug tracker). + +=cut + +sub bts_forwarded { + my $bug = checkbug(shift) + or die "bts forwarded: mark what bug as forwarded?\n"; + my $email = join(' ', @_); + if ($email =~ /$btsserver/) { + die +"bts forwarded: We don't forward bugs within $btsserver, use bts reassign instead\n"; + } + if (!length $email) { + die + "bts forwarded: mark bug $bug as forwarded to what email address?\n"; + } + mailbts("bug $bug is forwarded to $email", "forwarded $bug $email"); +} + +=item B<notforwarded> I<bug> + +Mark a I<bug> as not forwarded. + +=cut + +sub bts_notforwarded { + my $bug = checkbug(shift) or die "bts notforwarded: what bug?\n"; + opts_done(@_); + mailbts("bug $bug is not forwarded", "notforwarded $bug"); +} + +=item B<package> [I<package> ...] + +The following commands will only apply to bugs against the listed +I<package>s; this acts as a safety mechanism for the BTS. If no packages +are listed, this check is turned off again. + +=cut + +sub bts_package { + if (@_) { + bts_limit(map { "package:$_" } @_); + } else { + bts_limit('package'); + } +} + +=item B<limit> [I<key>[B<:>I<value>]] ... + +The following commands will only apply to bugs which meet the specified +criterion; this acts as a safety mechanism for the BTS. If no I<value>s are +listed, the limits for that I<key> are turned off again. If no I<key>s are +specified, all limits are reset. + +=over 8 + +=item B<submitter> + +E-mail address of the submitter. + +=item B<date> + +Date the bug was submitted. + +=item B<subject> + +Subject of the bug. + +=item B<msgid> + +Message-id of the initial bug report. + +=item B<package> + +Binary package name. + +=item B<source> + +Source package name. + +=item B<tag> + +Tags applied to the bug. + +=item B<severity> + +Bug severity. + +=item B<owner> + +Bug's owner. + +=item B<affects> + +Bugs affecting this package. + +=item B<archive> + +Whether to search archived bugs or normal bugs; defaults to B<0> +(i.e. only search normal bugs). As a special case, if archive is +B<both>, both archived and unarchived bugs are returned. + +=back + +For example, to limit the set of bugs affected by the subsequent control +commands to those submitted by jrandomdeveloper@example.com and tagged +B<wontfix>, one would use + +bts limit submitter:jrandomdeveloper@example.com tag:wontfix + +If a key is used multiple times then the set of bugs selected includes +those matching any of the supplied values; for example + +bts limit package:foo severity:wishlist severity:minor + +only applies the subsequent control commands to bugs of package foo with +either B<wishlist> or B<minor> severity. + +=cut + +sub bts_limit { + my @args = @_; + my %limits; + # Ensure we're using the limit fields that debbugs expects. These are the + # keys from Debbugs::Status::fields + my %valid_keys = ( + submitter => 'originator', + date => 'date', + subject => 'subject', + msgid => 'msgid', + package => 'package', + source => 'source', + src => 'source', + tag => 'keywords', + severity => 'severity', + owner => 'owner', + affects => 'affects', + archive => 'unarchived', + ); + for my $arg (@args) { + my ($key, $value) = split /:/, $arg, 2; + next unless $key; + if (!defined $value) { + die "bts limit: No value given for '$key'\n"; + } + if (exists $valid_keys{$key}) { + # Support "$key:" by making it look like "$key", i.e. no $value + # defined + undef $value unless length($value); + if ($key eq "archive") { + if (defined $value) { + # limit looks for unarchived, not archive. Verify we have + # a valid value and then switch the boolean value to match + # archive => unarchive + if ($value =~ /^yes|1|true|on$/i) { + $value = 0; + } elsif ($value =~ /^no|0|false|off$/i) { + $value = 1; + } elsif ($value ne 'both') { + die "bts limit: Invalid value ($value) for archive\n"; + } + } + } + $key = $valid_keys{$key}; + if (defined $value and $value) { + push(@{ $limits{$key} }, $value); + } else { + $limits{$key} = (); + } + } elsif ($key eq 'clear') { + %limits = (); + $limits{$key} = 1; + } else { + die "bts limit: Unrecognized key: $key\n"; + } + } + for my $key (keys %limits) { + if ($key eq 'clear') { + mailbts('clear all limit(s)', 'limit clear'); + next; + } + if (defined $limits{$key}) { + my $value = join ' ', @{ $limits{$key} }; + mailbts("limit $key to $value", "limit $key $value"); + } else { + mailbts("clear $key limit", "limit $key"); + } + } +} + +=item B<owner> I<bug> I<owner-email> + +Change the "owner" address of a I<bug>, with B<!> meaning +`use the address on the current email as the new owner address'. + +The owner of a bug accepts responsibility for dealing with it. + +=cut + +sub bts_owner { + my $bug = checkbug(shift) or die "bts owner: change owner of what bug?\n"; + my $owner = checkemail(shift, 1) + or die "bts owner: change owner to what?\n"; + opts_done(@_); + mailbts("owner $bug", "owner $bug $owner"); +} + +=item B<noowner> I<bug> + +Mark a bug as having no "owner". + +=cut + +sub bts_noowner { + my $bug = checkbug(shift) or die "bts noowner: what bug?\n"; + opts_done(@_); + mailbts("bug $bug has no owner", "noowner $bug"); +} + +=item B<subscribe> I<bug> [I<email>] + +Subscribe the given I<email> address to the specified I<bug> report. If no email +address is specified, the environment variable B<DEBEMAIL> or B<EMAIL> (in that +order) is used. If those are not set, or B<!> is given as email address, +your default address will be used. + +After executing this command, you will be sent a subscription confirmation to +which you have to reply. When subscribed to a bug report, you receive all +relevant emails and notifications. Use the unsubscribe command to unsubscribe. + +=cut + +sub bts_subscribe { + my $bug = checkbug(shift) or die "bts subscribe: subscribe to what bug?\n"; + my $email = checkemail(shift, 1); + $email = lc($email) if defined $email; + if (defined $email and $email eq '!') { $email = undef; } + else { + $email ||= $ENV{'DEBEMAIL'}; + $email ||= $ENV{'EMAIL'}; + $email = extractemail($email) if defined $email; + } + opts_done(@_); + mailto( + 'subscription request for bug #' . $bug, '', + $bug . '-subscribe@' . $btsserver, $email + ); +} + +=item B<unsubscribe> I<bug> [I<email>] + +Unsubscribe the given email address from the specified bug report. As with +subscribe above, if no email address is specified, the environment variables +B<DEBEMAIL> or B<EMAIL> (in that order) is used. If those are not set, or B<!> is +given as email address, your default address will be used. + +After executing this command, you will be sent an unsubscription confirmation +to which you have to reply. Use the B<subscribe> command to, well, subscribe. + +=cut + +sub bts_unsubscribe { + my $bug = checkbug(shift) + or die "bts unsubscribe: unsubscribe from what bug?\n"; + my $email = checkemail(shift, 1); + $email = lc($email) if defined $email; + if (defined $email and $email eq '!') { $email = undef; } + else { + $email ||= $ENV{'DEBEMAIL'}; + $email ||= $ENV{'EMAIL'}; + $email = extractemail($email) if defined $email; + } + opts_done(@_); + mailto( + 'unsubscription request for bug #' . $bug, '', + $bug . '-unsubscribe@' . $btsserver, $email + ); +} + +=item B<reportspam> I<bug> ... + +The B<reportspam> command allows you to report a I<bug> report as containing spam. +It saves one from having to go to the bug web page to do so. + +=cut + +sub bts_reportspam { + my @bugs; + + if (!have_lwp()) { + die "$progname: Couldn't run bts reportspam: $lwp_broken\n"; + } + + foreach (@_) { + my $bug = checkbug($_) + or die "bts reportspam: some bug number(s) not valid\n"; + push @bugs, $bug; + } + @bugs >= 1 + or die "bts reportspam: at least one bug number must be specified\n"; + + init_agent() unless $ua; + foreach my $bug (@bugs) { + my $url = "$btscgispamurl?bug=$bug;ok=ok"; + if ($noaction) { + print "bts reportspam: would report $bug as containing spam (URL: " + . $url . ")\n"; + } else { + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + if (!$response->is_success) { + warn "$progname: failed to report $bug as containing spam: " + . $response->status_line . "\n"; + } + } + } +} + +=item B<spamreport> I<bug> ... + +B<spamreport> is a synonym for B<reportspam>. + +=cut + +sub bts_spamreport { + goto &bts_reportspam; +} + +=item B<cache> [I<options>] [I<maint_email> | I<pkg> | B<src:>I<pkg> | B<from:>I<submitter>] + +=item B<cache> [I<options>] [B<release-critical> | B<release-critical/>... | B<RC>] + +Generate or update a cache of bug reports for the given email address +or package. By default it downloads all bugs belonging to the email +address in the B<DEBEMAIL> environment variable (or the B<EMAIL> environment +variable if B<DEBEMAIL> is unset). This command may be repeated to cache +bugs belonging to several people or packages. If multiple packages or +addresses are supplied, bugs belonging to any of the arguments will be +cached; those belonging to more than one of the arguments will only be +downloaded once. The cached bugs are stored in +F<$XDG_CACHE_HOME/devscripts/bts/> or, if B<XDG_CACHE_HOME> is not set, in +F<~/.cache/devscripts/bts/>. + +You can use the cached bugs with the B<-o> switch. For example: + + bts -o bugs + bts -o show 12345 + +Also, B<bts> will update the files in it in a piecemeal fashion as it +downloads information from the BTS using the B<show> command. You might +thus set up the cache, and update the whole thing once a week, while +letting the automatic cache updates update the bugs you frequently +refer to during the week. + +Some options affect the behaviour of the B<cache> command. The first is +the setting of B<--cache-mode>, which controls how much B<bts> downloads +of the referenced links from the bug page, including boring bits such +as the acknowledgement emails, emails to the control bot, and the mbox +version of the bug report. It can take three values: B<min> (the +minimum), B<mbox> (download the minimum plus the mbox version of the bug +report) or B<full> (the whole works). The second is B<--force-refresh> or +B<-f>, which forces the download, even if the cached bug report is +up-to-date. The B<--include-resolved> option indicates whether bug +reports marked as resolved should be downloaded during caching. + +Each of these is configurable from the configuration +file, as described below. They may also be specified after the +B<cache> command as well as at the start of the command line. + +Finally, B<-q> or B<--quiet> will suppress messages about caches being +up-to-date, and giving the option twice will suppress all cache +messages (except for error messages). + +Beware of caching RC, though: it will take a LONG time! (With 1000+ +RC bugs and a delay of 5 seconds between bugs, you're looking at a +minimum of 1.5 hours, and probably significantly more than that.) + +=cut + +sub bts_cache { + @ARGV = @_; + my ($sub_cachemode, $sub_refreshmode, $sub_updatemode); + my $sub_quiet = $quiet; + my $sub_includeresolved = $includeresolved; + GetOptions( + "cache-mode|cachemode=s" => \$sub_cachemode, + "f" => \$sub_refreshmode, + "force-refresh!" => \$sub_refreshmode, + "only-new!" => \$sub_updatemode, + "q|quiet+" => \$sub_quiet, + "include-resolved!" => \$sub_includeresolved, + ) or die "$progname: unknown options for cache command\n"; + @_ = @ARGV; # whatever's left + + if (defined $sub_refreshmode) { + ($refreshmode, $sub_refreshmode) = ($sub_refreshmode, $refreshmode); + } + if (defined $sub_updatemode) { + ($updatemode, $sub_updatemode) = ($sub_updatemode, $updatemode); + } + if (defined $sub_cachemode) { + if ($sub_cachemode =~ $cachemode_re) { + ($cachemode, $sub_cachemode) = ($sub_cachemode, $cachemode); + } else { + warn +"$progname: ignoring invalid --cache-mode $sub_cachemode;\nmust be one of min, mbox, full.\n"; + } + } + # This may be a no-op, we don't mind + ($quiet, $sub_quiet) = ($sub_quiet, $quiet); + ($includeresolved, $sub_includeresolved) + = ($sub_includeresolved, $includeresolved); + + prunecache(); + if (!have_lwp()) { + die "$progname: Couldn't run bts cache: $lwp_broken\n"; + } + + if (!-d $cachedir) { + my $err; + make_path($cachedir, { error => \$err }); + if (@$err) { + my ($path, $msg) = each(%{ $err->[0] }); + die "$progname: couldn't mkdir $path: $msg\n"; + } + } + + download("css/bugs.css"); + + my $tocache; + if (@_ > 0) { $tocache = sanitizething(shift); } + else { $tocache = ''; } + + if (!length $tocache) { + $tocache = $ENV{'DEBEMAIL'} || $ENV{'EMAIL'} || ''; + if ($tocache =~ /^.*\s<(.*)>\s*$/) { $tocache = $1; } + } + if (!length $tocache) { + die "bts cache: cache what?\n"; + } + + my $sub_thgopts = ''; + $sub_thgopts = ';pend-exc=done' + if (!$includeresolved && $tocache !~ /^release-critical/); + + my %bugs = (); + my %oldbugs = (); + + do { + %oldbugs = (%oldbugs, + map { $_ => 1 } bugs_from_thing($tocache, $sub_thgopts)); + + # download index + download($tocache, $sub_thgopts, 1); + + %bugs + = (%bugs, map { $_ => 1 } bugs_from_thing($tocache, $sub_thgopts)); + + $tocache = sanitizething(shift); + } while (defined $tocache); + + # remove old bugs from cache + if (keys %oldbugs) { + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDWR() | O_CREAT(), + 0600, $DB_HASH, "write") + or die + "$progname: couldn't open DB file $timestampdb for writing: $!\n" + if !tied %timestamp; + } + + foreach my $bug (keys %oldbugs) { + if (!$bugs{$bug}) { + deletecache($bug); + } + } + + untie %timestamp; + + # download bugs + my $bugcount = 1; + my $bugtotal = scalar keys %bugs; + foreach my $bug (keys %bugs) { + if (-f cachefile($bug, '') and $updatemode) { + print "Skipping $bug as requested ... $bugcount/$bugtotal\n" + if !$quiet; + $bugcount++; + next; + } + download($bug, '', 1, 0, $bugcount, $bugtotal); + sleep $opt_cachedelay; + $bugcount++; + } + + # revert options + if (defined $sub_refreshmode) { + $refreshmode = $sub_refreshmode; + } + if (defined $sub_updatemode) { + $updatemode = $sub_updatemode; + } + if (defined $sub_cachemode) { + $cachemode = $sub_cachemode; + } + $quiet = $sub_quiet; + $includeresolved = $sub_includeresolved; +} + +=item B<cleancache> I<package> | B<src:>I<package> | I<maintainer> + +=item B<cleancache from:>I<submitter> | B<tag:>I<tag> | B<usertag:>I<tag> | I<number> | B<ALL> + +Clean the cache for the specified I<package>, I<maintainer>, etc., as +described above for the B<bugs> command, or clean the entire cache if +B<ALL> is specified. This is useful if you are going to have permanent +network access or if the database has become corrupted for some +reason. Note that for safety, this command does not default to the +value of B<DEBEMAIL> or B<EMAIL>. + +=cut + +sub bts_cleancache { + prunecache(); + my $toclean = sanitizething(shift); + if (!defined $toclean) { + die "bts cleancache: clean what?\n"; + } + if (!-d $cachedir) { + return; + } + if ($toclean eq 'ALL') { + if (system("/bin/rm", "-rf", $cachedir) >> 8 != 0) { + warn "Problems cleaning cache: $!\n"; + } + return; + } + + # clean index + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDWR() | O_CREAT(), + 0600, $DB_HASH, "write") + or die "$progname: couldn't open DB file $timestampdb for writing: $!\n" + if !tied %timestamp; + + if ($toclean =~ /^\d+$/) { + # single bug only + deletecache($toclean); + } else { + my @bugs_to_clean = bugs_from_thing($toclean); + deletecache($toclean); + + # remove old bugs from cache + foreach my $bug (@bugs_to_clean) { + deletecache($bug); + } + } + + untie %timestamp; +} + +=item B<listcachedbugs> [I<number>] + +List cached bug ids (intended to support bash completion). The optional number argument +restricts the list to those bug ids that start with that number. + +=cut + +sub bts_listcachedbugs { + my $number = shift; + if (not defined $number) { + $number = ''; + } + if ($number =~ m{\D}) { + return; + } + my $untie = 0; + if (not tied %timestamp) { + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDONLY(), 0600, $DB_HASH, "read") + or die + "$progname: couldn't open DB file $timestampdb for reading: $!\n"; + $untie = 1; + } + + print join "\n", grep { $_ =~ m{^$number\d+$} } sort keys %timestamp; + print "\n"; + + if ($untie) { + untie %timestamp; + } +} + +# Add any new commands here. + +=item B<version> + +Display version and copyright information. + +=cut + +sub bts_version { + print <<"EOF"; +$progname version $version +Copyright (C) 2001-2003 by Joey Hess <joeyh\@debian.org>. +Modifications Copyright (C) 2002-2004 by Julian Gilbey <jdg\@debian.org>. +Modifications Copyright (C) 2007 by Josh Triplett <josh\@freedesktop.org>. +It is licensed under the terms of the GPL, either version 2 of the +License, or (at your option) any later version. +EOF +} + +=item B<help> + +Display a short summary of commands, suspiciously similar to parts of this +man page. + +=cut + +# Other supporting subs + +# This must be the last bts_* sub +sub bts_help { + my $inlist = 0; + my $insublist = 0; + print <<"EOF"; +Usage: $progname [options] command [args] [\#comment] [.|, command ... ] +Valid options are: + -o, --offline Do not attempt to connect to BTS for show/bug + commands: use cached copy + --online, --no-offline Attempt to connect (default) + -n, --no-action Do not send emails but print them to standard output. + --no-cache Do not attempt to cache new versions of BTS + pages when performing show/bug commands + --cache Do attempt to cache new versions of BTS + pages when performing show/bug commands (default) + --cache-mode={min|mbox|full} + How much to cache when we are caching: the sensible + bare minimum (default), the mbox as well, or + everything? + --cache-delay=seconds Time to sleep between each download when caching. + -m, --mbox With show or bugs, open a mailreader to read the mbox + version instead + --mailreader=CMD Run CMD to read an mbox; default is 'mutt -f %s' + (must contain %s, which is replaced by mbox name) + --cc-addr=CC_EMAIL_ADDRESS + Send carbon copies to a list of users. + CC_EMAIL_ADDRESS should be a comma-separated list of + e-mail addresses. + --use-default-cc Send carbon copies to any addresses specified in the + configuration file BTS_DEFAULT_CC (default) + --no-use-default-cc Do not do so + --sendmail=cmd Sendmail command to use (default /usr/sbin/sendmail) + --mutt Use mutt for sending of mails. + --no-mutt Do not do so (default) + --smtp-host=host SMTP host to use + --smtp-username=user } Credentials to use when connecting to an SMTP + --smtp-password=pass } server which requires authentication + --smtp-helo=helo HELO to use when connecting to the SMTP server; + (defaults to the content of /etc/mailname) + --bts-server The name of the debbugs server to use + (default https://bugs.debian.org) + -f, --force-refresh Reload all bug reports being cached, even unchanged + ones + --no-force-refresh Do not do so (default) + --only-new Download only new bugs when caching. Do not check + for updates in bugs we already have. + --include-resolved Cache bugs marked as resolved (default) + --no-include-resolved Do not cache bugs marked as resolved + --no-ack Suppress BTS acknowledgment mails + --ack Do not do so (default) + -i, --interactive Prompt for confirmation before sending e-mail + --force-interactive Same as --interactive, with the exception that an + editor is spawned before confirmation is requested + --no-interactive Do not do so (default) + -q, --quiet Only display information about newly cached pages. + If given twice, only display error messages. + --no-conf, --noconf Do not read devscripts config files; + must be the first option given + -h, --help Display this message + -v, --version Display version and copyright info + +Default settings modified by devscripts configuration files: +$modified_conf_msg + +Valid commands are: +EOF + seek DATA, 0, 0; + while (<DATA>) { + $inlist = 1 if /^=over 4/; + next unless $inlist; + $insublist = 1 if /^=over [^4]/; + $insublist = 0 if /^=back/; + if (/^=item\sB<([^->].*)>/ and !$insublist) { + if ($1 eq 'help') { + last; + } + # Strip POD markup before displaying and ensure we don't wrap + # longer lines + my $parser = Pod::BTS->new(width => 100); + $parser->no_whining(1); + $parser->output_fh(\*STDOUT); + $parser->parse_string_document($_); + } + } +} + +# Strips any leading # or Bug# and trailing : from a thing if what's left is +# a pure positive number; +# also RC is a synonym for release-critical/other/all.html +sub sanitizething { + my $bug = $_[0]; + defined $bug or return undef; + + return 'release-critical/other/all.html' if $bug eq 'RC'; + return 'release-critical/index.html' if $bug eq 'release-critical'; + $bug =~ s/^(?:(?:Bug)?\#)?(\d+):?$/$1/; + return $bug; +} + +# Perform basic validation of an argument which should be an email address, +# handling ! if allowed +sub checkemail { + my $email = $_[0] or return; + my $allowbang = $_[1]; + + if ($email !~ /\@/ && (!$allowbang || $email ne '!')) { + return; + } + + return $email; +} + +# Validate a bug number. Strips out extraneous leading junk, allowing +# for things like "#74041" and "Bug#94921" +sub checkbug { + my $bug = $_[0] or return ""; + my $quiet = $_[1] || 0; # used when we don't want warnings from checkbug + + if ($bug eq 'it') { + if (not defined $it) { + die +"$progname: You specified 'it', but no previous bug number referenced!\n"; + } + } else { + $bug =~ s/^(?:(?:bug)?\#)?(-?\d+):?$/$1/i; + if (!exists $clonedbugs{$bug} + && (!length $bug || $bug !~ /^[0-9]+$/)) { + warn "\"$_[0]\" does not look like a bug number\n" unless $quiet; + return ""; + } + + # Valid, now set $it to this so that we can refer to it by 'it' later + $it = $bug; + } + + return $it; +} + +# Stores up some extra information for a mail to the bts. +sub mailbts { + if ($subject eq '') { + $subject = $_[0]; + } elsif (length($subject) + length($_[0]) < 100) { + $subject .= ", $_[0]" if length($_[0]); + } elsif ($subject !~ / ...$/) { + $subject .= " ..."; + } + $body .= "$comment[$index]\n" if $comment[$index]; + $body .= "$_[1]\n"; +} + +# Extract an array of email addresses from a string +sub extract_addresses { + my $s = shift; + my @addresses; + + # Original regular expression from git-send-email, slightly modified + while ($s and $s =~ /([^,<>"\s\@]+\@[^.,<>"\s@]+(?:\.[^.,<>"\s\@]+)+)(.*)/) + { + push @addresses, $1; + $s = $2; + } + return @addresses; +} + +# Send one full mail message using the smtphost or sendmail. +sub send_mail { + my ($from, $to, $cc, $subject, $body) = @_; + + my @fromaddresses = extract_addresses($from); + unless (@fromaddresses) { + die "Something went wrong: no from address" unless $noaction; + @fromaddresses = ($from = '<undefined>'); + } + my $fromaddress = $fromaddresses[0]; + # Message-ID algorithm from git-send-email + my $msgid + = sprintf("%s-%s", time(), int(rand(4200))) . "-bts-$fromaddress"; + my $date = strftime "%a, %d %b %Y %T %z", localtime; + + my $message = fold_from_header("From: $from") . "\n"; + $message .= "To: $to\n" if length $to; + $message .= "Cc: $cc\n" if length $cc; + $message .= "X-Debbugs-No-Ack: Yes\n" if not $requestack; + $message + .= "Subject: $subject\n" + . "Date: $date\n" + . "User-Agent: devscripts bts/$version$toolname\n" + . "Message-ID: <$msgid>\n" . "\n"; + + $body = addfooter($body); + ($message, $body) = confirmmail($message, $body); + + return if not defined $body; + + $message .= "$body\n"; + if ($noaction) { + print "$message\n"; + } elsif ($use_mutt) { + my ($fh, $filename) = tempfile( + "btsXXXXXX", + SUFFIX => ".mail", + DIR => File::Spec->tmpdir, + UNLINK => 1 + ); + open(MAILOUT, ">&", $fh) + or die "$progname: writing to temporary file: $!\n"; + + print MAILOUT $message; + + my $mailcmd = $muttcmd; + $mailcmd =~ s/\%([%s])/$1 eq '%' ? '%' : $filename/eg; + + exec($mailcmd) or die "$progname: unable to start mailclient: $!"; + } elsif (length $smtphost) { + my $smtp; + + if ($smtphost =~ m%^(?:(?:ssmtp|smtps)://)(.*)$%) { + my ($host, $port) = split(/:/, $1); + $port ||= '465'; + + if (have_smtps) { + $smtp = Net::SMTPS->new( + $host, + Port => $port, + Hello => $smtphelo, + doSSL => 'ssl' + ) + or die +"$progname: failed to open SMTPS connection to $smtphost\n($@)\n"; + } else { + die +"$progname: Unable to establish SMTPS connection: $smtps_broken\n"; + } + } else { + my ($host, $port) = split(/:/, $smtphost); + $port ||= '25'; + + if (have_smtps) { + $smtp = Net::SMTPS->new( + $host, + Port => $port, + Hello => $smtphelo, + doSSL => 'starttls' + ) + or die +"$progname: failed to open SMTP connection to $smtphost\n($@)\n"; + } else { + $smtp + = Net::SMTP->new($host, Port => $port, Hello => $smtphelo) + or die +"$progname: failed to open SMTP connection to $smtphost\n($@)\n"; + } + } + if ($smtpuser) { + if (have_authen_sasl) { + $smtppass = getpass() if not $smtppass; + $smtp->auth($smtpuser, $smtppass) + or die + "$progname: failed to authenticate to $smtphost\n($@)\n"; + } else { + die +"$progname: failed to authenticate to $smtphost: $authen_sasl_broken\n"; + } + } + $smtp->mail($fromaddress) + or die + "$progname: failed to set SMTP from address $fromaddress\n($@)\n"; + my @addresses = extract_addresses($to); + push @addresses, extract_addresses($cc); + foreach my $address (@addresses) { + $smtp->recipient($address) + or die + "$progname: failed to set SMTP recipient $address\n($@)\n"; + } + $smtp->data($message) + or die "$progname: failed to send message as SMTP DATA\n($@)\n"; + $smtp->quit + or die "$progname: failed to quit SMTP connection\n($@)\n"; + } else { + my $pid = open(MAIL, "|-"); + if (!defined $pid) { + die "$progname: Couldn't fork: $!\n"; + } + $SIG{'PIPE'} = sub { die "$progname: pipe for $sendmailcmd broke\n"; }; + if ($pid) { + # parent + print MAIL $message; + close MAIL or die "$progname: $sendmailcmd error: $!\n"; + } else { + # child + if ($debug) { + exec("/bin/cat") + or die "$progname: error running cat: $!\n"; + } else { + my @mailcmd = split ' ', $sendmailcmd; + push @mailcmd, "-t" if $sendmailcmd =~ /$sendmail_t/; + exec @mailcmd + or die "$progname: error running $sendmailcmd: $!\n"; + } + } + } +} + +sub generate_packages_cc { + my @ccs; + if (keys %ccpackages && $packagesserver) { + push @ccs, map { "$_\@$packagesserver" } sort keys %ccpackages; + } + if (keys %ccsubmitters && $btsserver) { + push @ccs, map { "$_\@$btsserver" } sort keys %ccsubmitters; + } + return join(', ', @ccs); +} + +# Sends all cached mail to the bts (duh). +sub mailbtsall { + my $subject = shift; + my $body = shift; + + my $charset = `locale charmap`; + chomp $charset; + $charset =~ s/^ANSI_X3\.4-19(68|86)$/US-ASCII/; + $subject = MIME_encode_mimewords($subject, 'Charset' => $charset); + + if ($interactive eq 'force') { + $ccemail .= ", " if length $ccemail; + $ccemail .= generate_packages_cc(); + } + if ($ccsecurity) { + my $comma = ""; + if ($ccemail) { + $comma = ", "; + } + $ccemail = "$ccemail$comma$ccsecurity"; + } + if ($ENV{'DEBEMAIL'} || $ENV{'EMAIL'}) { + # We need to fake the From: line + my ($email, $name); + if (exists $ENV{'DEBFULLNAME'}) { $name = $ENV{'DEBFULLNAME'}; } + if (exists $ENV{'DEBEMAIL'}) { + $email = $ENV{'DEBEMAIL'}; + if ($email =~ /^(.*?)\s+<(.*)>\s*$/) { + $name ||= $1; + $email = $2; + } + } + if (exists $ENV{'EMAIL'}) { + if ($ENV{'EMAIL'} =~ /^(.*?)\s+<(.*)>\s*$/) { + $name ||= $1; + $email ||= $2; + } else { + $email ||= $ENV{'EMAIL'}; + } + } + if (!$name) { + # Perhaps not ideal, but it will have to do + $name = (getpwuid($<))[6]; + $name =~ s/,.*//; + } + my $from = $name ? "$name <$email>" : $email; + $from = MIME_encode_mimewords($from, 'Charset' => $charset); + + send_mail($from, $btsemail, $ccemail, $subject, $body); + } else { # No DEBEMAIL + my $header = ""; + + $header = "To: $btsemail\n"; + $header .= "Cc: $ccemail\n" if length $ccemail; + $header .= "X-Debbugs-No-Ack: Yes\n" if not $requestack; + $header .= "Subject: $subject\n" + . "User-Agent: devscripts bts/$version$toolname\n" . "\n"; + + $body = addfooter($body); + ($header, $body) = confirmmail($header, $body); + + return if not defined $body; + + if ($noaction) { + print "$header$body\n"; + return; + } + + my $pid = open(MAIL, "|-"); + if (!defined $pid) { + die "$progname: Couldn't fork: $!\n"; + } + $SIG{'PIPE'} = sub { die "$progname: pipe for $sendmailcmd broke\n"; }; + if ($pid) { + # parent + print MAIL $header; + print MAIL $body; + close MAIL or die "$progname: $sendmailcmd: $!\n"; + } else { + # child + if ($debug) { + exec("/bin/cat") + or die "$progname: error running cat: $!\n"; + } else { + my @mailcmd = split ' ', $sendmailcmd; + push @mailcmd, "-t" if $sendmailcmd =~ /$sendmail_t/; + exec @mailcmd + or die "$progname: error running $sendmailcmd: $!\n"; + } + } + } +} + +sub confirmmail { + my ($header, $body) = @_; + + return ($header, $body) if $noaction; + + $body = edit($body) if $interactive eq 'force'; + my $setHeader = 0; + if ($interactive ne 'no') { + while (1) { + print "\n", $header, "\n", $body, "\n---\n"; + print "OK to send? [Y/n/e] "; + $_ = <STDIN>; + if (/^n/i) { + $body = undef; + last; + } elsif (/^(y|$)/i) { + last; + } elsif (/^e/i) { + # Since the user has chosen to edit the message, we go ahead + # and add the $ccpackages Ccs (if they haven't already been + # added due to interactive). + if ($interactive ne 'force' && !$setHeader) { + $setHeader = 1; + my $ccs = generate_packages_cc(); + if ($header =~ m/^Cc: (.*?)$/m) { + $ccs = "$1, $ccs"; + $header =~ s/^Cc: .*?$/Cc: $ccs/m; + } else { + $header =~ s/^(To: .*?)$/$1\nCc: $ccs/m; + } + } + $body = edit($body); + } + } + } + + return ($header, $body); +} + +sub addfooter() { + my $body = shift; + + $body .= "thanks\n"; + if ($interactive eq 'force') { + if (-r $ENV{'HOME'} . "/.signature") { + if (open SIG, "<", $ENV{'HOME'} . "/.signature") { + $body .= "-- \n"; + while (<SIG>) { + $body .= $_; + } + close SIG; + } + } + } + + return $body; +} + +sub getpass() { + system "stty -echo cbreak </dev/tty"; + die "$progname: error disabling stty echo\n" if $?; + print "\a${smtpuser}"; + print "\@$smtphost" if $smtpuser !~ /\@/; + print "'s SMTP password: "; + $_ = <STDIN>; + chomp; + print "\n"; + system "stty echo -cbreak </dev/tty"; + die "$progname: error enabling stty echo\n" if $?; + return $_; +} + +sub extractemail() { + my $thing = shift or die "$progname: extract e-mail from what?\n"; + + if ($thing =~ /^(.*?)\s+<(.*)>\s*$/) { + $thing = $2; + } + + return $thing; +} + +# A simplified version of mailbtsall which sends one message only to +# a specified address using the specified email From: header +sub mailto { + my ($subject, $body, $to, $from) = @_; + + if (defined($from) || $noaction) { + send_mail($from, $to, '', $subject, $body); + } else { # No $from + unless (system("command -v mailx >/dev/null 2>&1") == 0) { + die +"$progname: You need to either specify an email address (say using DEBEMAIL)\nor have the bsd-mailx package (or another package providing mailx) installed\nto send mail!\n"; + } + my $pid = open(MAIL, "|-"); + if (!defined $pid) { + die "$progname: Couldn't fork: $!\n"; + } + $SIG{'PIPE'} = sub { die "$progname: pipe for mailx broke\n"; }; + if ($pid) { + # parent + print MAIL $body; + close MAIL or die "$progname: mailx: $!\n"; + } else { + # child + if ($debug) { + exec("/bin/cat") + or die "$progname: error running cat: $!\n"; + } else { + exec("mailx", "-s", $subject, $to) + or die "$progname: error running mailx: $!\n"; + } + } + } +} + +# The following routines are taken from a patched version of MIME::Words +# posted at http://mail.nl.linux.org/linux-utf8/2002-01/msg00242.html +# by Richard =?utf-8?B?xIxlcGFz?= (Chepas) <rch@richard.eu.org> + +sub MIME_encode_B { + my $str = shift; + require MIME::Base64; + MIME::Base64::encode_base64($str, ''); +} + +sub MIME_encode_Q { + my $str = shift; + $str + =~ s{([_\?\=\015\012\t $NONPRINT])}{$1 eq ' ' ? '_' : sprintf("=%02X", ord($1))}eog + ; # RFC-2047, Q rule 3 + $str; +} + +sub MIME_encode_mimeword { + my $word = shift; + my $encoding = uc(shift || 'Q'); + my $charset = uc(shift || 'ISO-8859-1'); + my $encfunc = (($encoding eq 'Q') ? \&MIME_encode_Q : \&MIME_encode_B); + "=?$charset?$encoding?" . &$encfunc($word) . "?="; +} + +sub MIME_encode_mimewords { + my ($rawstr, %params) = @_; + # check if we have something to encode + $rawstr !~ /[$NONPRINT]/o and $rawstr !~ /\=\?/o and return $rawstr; + my $charset = $params{Charset} || 'ISO-8859-1'; + # if there is 1/3 unsafe bytes, the Q encoded string will be 1.66 times + # longer and B encoded string will be 1.33 times longer than original one + my $encoding = lc( + $params{Encoding} + || ( + length($rawstr) > 3 * ($rawstr =~ tr/[\x00-\x1F\x7F-\xFF]//) + ? 'q' + : 'b' + )); + + # Encode any "words" with unsafe bytes. + my ($last_token, $last_word_encoded, $token) = ('', 0); + $rawstr =~ s{([^\015\012\t ]+|[\015\012\t ]+)}{ # get next "word" + $token = $1; + if ($token =~ /[\015\012\t ]+/) { # white-space + $last_token = $token; + } else { + if ($token !~ /[$NONPRINT]/o and $token !~ /\=\?/o) { + # no unsafe bytes, leave as it is + $last_word_encoded = 0; + $last_token = $token; + } else { + # has unsafe bytes, encode to one or more encoded words + # white-space between two encoded words is skipped on + # decoding, so we should encode space in that case + $_ = $last_token =~ /[\015\012\t ]+/ && $last_word_encoded ? $last_token.$token : $token; + # We limit such words to about 18 bytes, to guarantee that the + # worst-case encoding give us no more than 54 + ~10 < 75 bytes + s{(.{1,15}[\x80-\xBF]{0,4})}{ + # don't split multibyte characters - this regexp should + # work for UTF-8 characters + MIME_encode_mimeword($1, $encoding, $charset).' '; + }sxeg; + $_ = substr($_, 0, -1); # remove trailing space + $last_word_encoded = 1; + $last_token = $token; + $_; + } + } + }sxeg; + $rawstr; +} + +# This is a stripped-down version of Mail::Header::_fold_line, but is +# not as general-purpose as the original, so take care if using it elsewhere! +# The heuristics are changed to prevent splitting in the middle of an +# encoded word; we should not have any commas or semicolons! +sub fold_from_header { + my $header = shift; + chomp $header; # We assume there wasn't a newline anyhow + + my $maxlen = 76; + my $max = int($maxlen - 5); # 4 for leading spcs + 1 for [\,\;] + + if (length($header) > $maxlen) { + # Split the line up: + # first split at a whitespace, + # else we are looking at a single word and we won't try to split + # it, even though we really ought to + # But this could only happen if someone deliberately uses a really + # long name with no spaces in it. + my @x; + + push @x, $1 + while ( + $header =~ s/^\s* + ([^\"]{1,$max}\s + |[^\s\"]*(?:\"[^\"]*\"[ \t]?[^\s\"]*)+\s + |[^\s\"]+\s + ) + //x + ); + push @x, $header; + map { s/\s*$// } @x; + if (@x > 1 and length($x[-1]) + length($x[-2]) < $max) { + $x[-2] .= " $x[-1]"; + pop @x; + } + $x[0] =~ s/^\s*//; + $header = join("\n ", @x); + } + + $header =~ s/^(\S+)\n\s*(?=\S)/$1 /so; + return $header; +} + +########## Browsing and caching subroutines + +# Mirrors a given thing; if the online version is no newer than our +# cached version, then returns an empty string, otherwise returns the +# live thing as a (non-empty) string +sub download { + my $thing = shift; + my $thgopts = shift || ''; + my $manual = shift; # true="bts cache", false="bts show/bug" + my $mboxing = shift; # true="bts --mbox show/bugs", and only if $manual=0 + my $bug_current = shift; # current bug being downloaded if caching + my $bug_total = shift; # total things to download if caching + my $timestamp = 0; + my $versionstamp = ''; + my $url; + + my $oldcwd = getcwd; + + # What URL are we to download? + if ($thgopts ne '') { + # have to be intelligent here :/ + $url = thing_to_url($thing) . $thgopts; + } else { + # let the BTS be intelligent + $url = "$btsurl$thing"; + } + + if (!-d $cachedir) { + die "$progname: download() called but no cachedir!\n"; + } + + chdir($cachedir) || die "$progname: chdir $cachedir: $!\n"; + + if (-f cachefile($thing, $thgopts)) { + ($timestamp, $versionstamp) = get_timestamp($thing, $thgopts); + $timestamp ||= 0; + $versionstamp ||= 0; + # And ensure we preserve any manual setting + if (is_manual($timestamp)) { $manual = 1; } + } + + # do we actually have to do more than we might have thought? + # yes, if we've caching with --cache-mode=mbox or full and the bug had + # previously been cached in a less thorough format + my $forcedownload = 0; + if ($thing =~ /^\d+$/ and !$refreshmode) { + if (old_cache_format_version($versionstamp)) { + $forcedownload = 1; + } elsif ($cachemode ne 'min' or $mboxing) { + if (!-r mboxfile($thing)) { + $forcedownload = 1; + } elsif ($cachemode eq 'full' and -d $thing) { + opendir DIR, $thing + or die "$progname: opendir $cachedir/$thing: $!\n"; + my @htmlfiles = grep { /^\d+\.html$/ } readdir(DIR); + closedir DIR; + $forcedownload = 1 unless @htmlfiles; + } + } + } + + print "Downloading $url ... " + if !$quiet + and $manual + and $thing ne "css/bugs.css"; + IO::Handle::flush(\*STDOUT); + my ($ret, $msg, $livepage, $contenttype) + = bts_mirror($url, $timestamp, $forcedownload); + my $charset = $contenttype || ''; + if ($charset =~ m/charset=(.*?)(;|\Z)/) { + $charset = $1; + } else { + $charset = ""; + } + if ($ret == MIRROR_UP_TO_DATE) { + # we have an up-to-date version already, nothing to do + # and $timestamp is guaranteed to be well-defined + if (is_automatic($timestamp) and $manual) { + set_timestamp($thing, $thgopts, make_manual($timestamp), + $versionstamp); + } + + if (!$quiet and $manual and $thing ne "css/bugs.css") { + print "(cache already up-to-date) "; + print "$bug_current/$bug_total" if $bug_total; + print "\n"; + } + chdir $oldcwd or die "$progname: chdir $oldcwd failed: $!\n"; + return ""; + } elsif ($ret == MIRROR_DOWNLOADED) { + # Note the current timestamp, but don't record it until + # we've successfully stashed the data away + $timestamp = time; + + die "$progname: empty page downloaded\n" unless length $livepage; + + my $bug2filename = {}; + + if ($thing =~ /^\d+$/) { + # we've downloaded an individual bug, and it's been updated, + # so we need to also download all the attachments + $bug2filename + = download_attachments($thing, $livepage, $timestamp); + } + + my $data = $livepage; # work on a copy, not the original + my $cachefile = cachefile($thing, $thgopts); + open(OUT_CACHE, ">$cachefile") + or die "$progname: open $cachefile: $!\n"; + + $data = mangle_cache_file($data, $thing, $bug2filename, $timestamp, + $charset ? $contenttype : ''); + print OUT_CACHE $data; + close OUT_CACHE + or die "$progname: problems writing to $cachefile: $!\n"; + + set_timestamp($thing, $thgopts, + $manual ? make_manual($timestamp) : make_automatic($timestamp), + $version); + + if (!$quiet and $manual and $thing ne "css/bugs.css") { + print "(cached new version) "; + print "$bug_current/$bug_total" if $bug_total; + print "\n"; + } elsif ($quiet == 1 and $manual and $thing ne "css/bugs.css") { + print "Downloading $url ... (cached new version)\n"; + } elsif ($quiet > 1) { + # do nothing + } + + # Add a <base> tag to the live page content, so that relative urls + # in it work when it's passed to the web browser. + my $base = $url; + $base =~ s%/[^/]*$%%; + $livepage =~ s%<head>%<head><base href="$base">%i; + + chdir $oldcwd or die "$progname: chdir $oldcwd failed: $!\n"; + return $livepage; + } else { + die "$progname: couldn't download $url:\n$msg\n"; + } +} + +sub download_attachments { + my ($thing, $toppage, $timestamp) = @_; + my %bug2filename; + + # We search for appropriate strings in the top page, and save the + # attachments in files with names as follows: + # - if the attachment specifies a filename, save as bug#/msg#-att#/filename + # - if not, save as bug#/msg#-att# with suffix .txt if plain/text and + # .html if plain/html, no suffix otherwise (too much like hard work!) + # Since messages are never modified retrospectively, we don't download + # attachments which have already been downloaded + + # Yuck, yuck, yuck. This regex splits the $data string at every + # occurrence of either "[<a " or plain "<a ", preserving any "[". + my @data = split /(?:(?=\[<[Aa]\s)|(?<!\[)(?=<[Aa]\s))/, $toppage; + foreach (@data) { + next + unless +m%<a(?: class=\".*?\")? href="(?:/cgi(?:-bin)?/)?((bugreport\.cgi[^\"]+)"(?: .*?)?>|(version\.cgi[^\"]+)"><img[^>]* src="(?:/cgi(?:-bin)?/)?([^\"]+)">|(version\.cgi[^\"]+)">)%i; + + my $ref = $5; + $ref = $4 if not defined $ref; + $ref = $2 if not defined $ref; + + my ($msg, $filename) = href_to_filename($_); + + next unless defined $msg; + + if ($msg =~ /^\d+-\d+$/) { + # it's an attachment, must download + + if (-f dirname($filename)) { + warn +"$progname: found file where directory expected; using existing file (" + . dirname($filename) . ")\n"; + $bug2filename{$msg} = dirname($filename); + } else { + $bug2filename{$msg} = $filename; + } + + # already downloaded? + next if -f $bug2filename{$msg} and not $refreshmode; + } elsif ($cachemode eq 'full' and $msg =~ /^\d+$/) { + $bug2filename{$msg} = $filename; + # already downloaded? + next if -f $bug2filename{$msg} and not $refreshmode; + } elsif ($cachemode eq 'full' and $msg =~ /^\d+-mbox$/) { + $bug2filename{$msg} = $filename; + # already downloaded? + next if -f $bug2filename{$msg} and not $refreshmode; + } elsif (($cachemode eq 'full' or $cachemode eq 'mbox' or $mboxmode) + and $msg eq 'mbox') { + $bug2filename{$msg} = $filename; + # This always needs refreshing, as it does change as the bug + # changes + } elsif ($cachemode eq 'full' and $msg =~ /^(status|raw)mbox$/) { + $bug2filename{$msg} = $filename; + # Always need refreshing, as they could change each time the + # bug does + } elsif ($cachemode eq 'full' and $msg eq 'versions') { + $bug2filename{$msg} = $filename; + # Ensure we always download the full size images for + # version graphs, without the informational links + $ref =~ s%;info=1%;info=0%; + $ref =~ s%(;|\?)(height|width)=\d+%$1%g; + # already downloaded? + next if -f $bug2filename{$msg} and not $refreshmode; + } + + next unless exists $bug2filename{$msg}; + + warn "bts debug: downloading $btscgiurl$ref\n" if $debug; + init_agent() unless $ua; # shouldn't be necessary, but do just in case + my $request = HTTP::Request->new('GET', $btscgiurl . $ref); + my $response = $ua->request($request); + if ($response->is_success) { + my $content_length + = defined $response->content ? length($response->content) : 0; + if ($content_length == 0) { + warn "$progname: failed to download $ref, skipping\n"; + next; + } + + my $data = $response->content; + + if ($msg =~ /^\d+$/) { + # we're dealing with a boring message, and so we must be + # in 'full' mode + $data =~ s%<HEAD>%<HEAD><BASE href="../">%; + $data = mangle_cache_file($data, $thing, 'full', $timestamp); + } + make_path(dirname($bug2filename{$msg})); + open OUT_CACHE, ">$bug2filename{$msg}" + or die "$progname: open cache $bug2filename{$msg}\n"; + print OUT_CACHE $data; + close OUT_CACHE; + } else { + warn "$progname: failed to download $ref, skipping\n"; + next; + } + } + + return \%bug2filename; +} + +# Download the mailbox for a given bug, return mbox ($fh, filename) on success, +# die on failure +sub download_mbox { + my $thing = shift; + my $temp = shift; # do we wish to store it in cache or in a temp file? + my $mboxfile = mboxfile($thing); + + die "$progname: trying to download mbox for illegal bug number $thing.\n" + unless $mboxfile; + + if (!have_lwp()) { + die "$progname: couldn't run bts --mbox: $lwp_broken\n"; + } + init_agent() unless $ua; + + my $request = HTTP::Request->new('GET', + $btscgiurl . "bugreport.cgi?bug=$thing;mboxmaint=yes"); + my $response = $ua->request($request); + if ($response->is_success) { + my $content_length + = defined $response->content ? length($response->content) : 0; + if ($content_length == 0) { + die "$progname: failed to download mbox.\n"; + } + + my ($fh, $filename); + if ($temp) { + ($fh, $filename) = tempfile( + "btsXXXXXX", + SUFFIX => ".mbox", + DIR => File::Spec->tmpdir, + UNLINK => 1 + ); + # Use filehandle for security + open(OUT_MBOX, ">&", $fh) + or die "$progname: writing to temporary file: $!\n"; + } else { + $filename = $mboxfile; + open(OUT_MBOX, ">$mboxfile") + or die "$progname: writing to mbox file $mboxfile: $!\n"; + } + print OUT_MBOX $response->content; + close OUT_MBOX; + + return ($fh, $filename); + } else { + die "$progname: failed to download mbox.\n"; + } +} + +# Mangle downloaded file to work in the local cache, so +# selectively modify the links +sub mangle_cache_file { + my ($data, $thing, $bug2filename, $timestamp, $ctype) = @_; + my $fullmode = !ref $bug2filename; + + # Undo unnecessary '+' encoding in URLs + while ($data =~ s!(href=\"[^\"]*)\%2b!$1+!ig) { } + my $time = localtime(abs($timestamp)); + $data + =~ s%(<BODY.*>)%$1<p><em>[Locally cached on $time by devscripts version $version]</em></p>%i; + $data =~ s%href="/css/bugs.css"%href="bugs.css"%; + if ($ctype) { + $data + =~ s%(<HEAD.*>)%$1<META HTTP-EQUIV="Content-Type" CONTENT="$ctype">%i; + } + + my @data; + # We have to distinguish between release-critical pages and normal BTS + # pages as they have a different structure + if ($thing =~ /^release-critical/) { + @data = split /(?=<[Aa])/, $data; + foreach (@data) { +s%<a href="(https?://$btsserver/cgi(?:-bin)?/bugreport\.cgi.*bug=(\d+)[^\"]*)">(.+?)</a>%<a href="$2.html">$3</a> (<a href="$1">online</a>)%i; +s%<a href="(https?://$btsserver/cgi(?:-bin)?/pkgreport\.cgi.*pkg=([^\"&;]+)[^\"]*)">(.+?)</a>%<a href="$2.html">$3</a> (<a href="$1">online</a>)%i; + # References to other bug lists on bugs.d.o/release-critical + if (m%<a href="((?:debian|other)[-a-z/]+\.html)"%i) { + my $ref = 'release-critical/' . $1; + $ref =~ s%/%_%g; +s%<a href="((?:debian|other)[-a-z/]+\.html)">(.+?)</a>%<a href="$ref">$2</a> (<a href="${btsurl}release-critical/$1">online</a>)%i; + } + # Maintainer email address - YUCK!! +s%<a href="(https?://$btsserver/([^\"?]*\@[^\"?]*))">(.+?)</a>>%<a href="$2.html">$3</a>> (<a href="$1">online</a>)%i; + # Graph - we don't download +s%<img src="graph.png" alt="Graph of RC bugs">%<img src="${btsurl}release-critical/graph.png" alt="Graph of RC bugs (online)">%; + } + } else { + # Yuck, yuck, yuck. This regex splits the $data string at every + # occurrence of either "[<a " or plain "<a ", preserving any "[". + @data = split /(?:(?=\[<[Aa]\s)|(?<!\[)(?=<[Aa]\s))/, $data; + foreach (@data) { + if ( +m%<a(?: class=\".*?\")? href=\"(?:/cgi(?:-bin)?/)?bugreport\.cgi[^\?]*\?.*?;?bug=(\d+)%i + ) { + my $bug = $1; + my ($msg, $filename) = href_to_filename($_); + if ($bug eq $thing and defined $msg) { + if ($fullmode + or (!$fullmode and exists $$bug2filename{$msg})) { +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(bugreport\.cgi[^\"]*)">(.+?)</a>%<a$1 href="$filename">$3</a> (<a$1 href="$btscgiurl$2">online</a>)%i; + } else { +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(bugreport\.cgi[^\"]*)">(.+?)</a>%$3 (<a$1 href="$btscgiurl$2">online</a>)%i; + } + } else { +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(bugreport\.cgi[^\?]*\?.*?bug=(\d+))"(.*?)>(.+?)</a>%<a$1 href="$3.html"$4>$5</a> (<a$1 href="$btscgiurl$2">online</a>)%i; + } + } else { +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(pkgreport\.cgi\?(?:pkg|maint)=([^\"&;]+)[^\"]*)">(.+?)</a>%<a$1 href="$3.html">$4</a> (<a$1 href="$btscgiurl$2">online</a>)%gi; +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(pkgreport\.cgi\?src=([^\"&;]+)[^\"]*)">(.+?)</a>%<a$1 href="src_$3.html">$4</a> (<a$1 href="$btscgiurl$2">online</a>)%i; +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(pkgreport\.cgi\?submitter=([^\"&;]+)[^\"]*)">(.+?)</a>%<a$1 href="from_$3.html">$4</a> (<a$1 href="$btscgiurl$2">online</a>)%i; +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(pkgreport\.cgi\?.*?;?archive=([^\"&;]+);submitter=([^\"&;]+)[^\"]*)">(.+?)</a>%<a$1 href="from_$4_3Barchive_3D$3.html">$5</a> (<a$1 href="$btscgiurl$2">online</a>)%i; +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(pkgreport\.cgi\?.*?;?package=([^\"&;]+)[^\"]*)">(.+?)</a>%<a$1 href="$3.html">$4</a> (<a$1 href="$btscgiurl$2">online</a>)%gi; +s%<a((?: class=\".*?\")?) href="(?:/cgi(?:-bin)?/)?(bugspam\.cgi[^\"]+)">%<a$1 href="$btscgiurl$2">%i; +s%<a((?: class=\".*?\")?) href="/([0-9]+?)">(.+?)</a>%<a$1 href="$2.html">$3</a> (<a$1 href="$btsurl$2">online</a>)%i; + + # Version graphs + # - remove 'package=' and move the package to the front +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?)([^\"]+)package=([^;\"]+)([^\"]+\"|\")>%$1$3;$2$4>%gi; + # - replace 'found=' with '.f.' and 'fixed=' with '.fx.' + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?)(.*?;)found=([^\"]+)\">%$1$2.f.$3">%i; + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?)(.*?;)fixed=([^\"]+)\">%$1$2.fx.$3">%i; + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?found=)([^\"]+)\">%$1.f.$2">%i; + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?fixed=)([^\"]+)\">%$1.fx.$2">%i; + # - replace '%2F' or '%2C' (a URL-encoded / or ,) with '.' + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?[^\%]*)\%2[FC]([^\"]+)\">%$1.$2">%gi; + # - display collapsed graph images at 25% +s%(<img[^>]* src=\"[^\"]+);collapse=1([^\"]+)\">%$1$2.co" width="25\%" height="25\%">%gi; + # - and link to the collapsed graph + s%(<a[^>]* href=\"[^\"]+);collapse=1([^\"]+)\">%$1$2.co">%gi; + # - remove any other parameters + 1 while +s%((?:<img[^>]* src|<a[^>]* href)=\"(?:/cgi(?:-bin)?/)?version\.cgi\?[^\"]+);(?:\w+=\d+)([^>]+)\>%$1$2>%gi; + # - remove any +s (encoded spaces) + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?[^\+]*)\+([^\"]+)\">%$1$2">%gi; + # - remove trailing ";" and ";." from previous substitutions + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?[^\"]+);\.(.*?)>%$1.$2>%gi; + 1 while +s%((?:<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?[^\"]+);\">%$1">%gi; + # - final reference should be $package.$versions[.co].png +s%(<img[^>]* src=\"|<a[^>]* href=\")(?:/cgi(?:-bin)?/)?version\.cgi\?([^\"]+)(\"[^>]*)>%$1$2.png$3>%gi; + } + } + } + + return join("", @data); +} + +# Removes a specified thing from the cache +sub deletecache { + my $thing = shift; + my $thgopts = shift || ''; + + if (!-d $cachedir) { + die "$progname: deletecache() called but no cachedir!\n"; + } + + delete_timestamp($thing, $thgopts); + unlink cachefile($thing, $thgopts); + if ($thing =~ /^\d+$/) { + rmtree("$cachedir/$thing", 0, 1) if -d "$cachedir/$thing"; + unlink("$cachedir/$thing.mbox") if -f "$cachedir/$thing.mbox"; + unlink("$cachedir/$thing.status.mbox") + if -f "$cachedir/$thing.status.mbox"; + unlink("$cachedir/$thing.raw.mbox") if -f "$cachedir/$thing.raw.mbox"; + } +} + +# Given a thing, returns the filename for it in the cache. +sub cachefile { + my $thing = shift; + my $thgopts = shift || ''; + if ($thing eq '') { die "$progname: cachefile given empty argument\n"; } + if ($thing =~ /bugs.css$/) { return $cachedir . "bugs.css" } + $thing =~ s/^src:/src_/; + $thing =~ s/^from:/from_/; + $thing =~ s/^tag:/tag_/; + $thing =~ s/^usertag:/usertag_/; + $thing =~ s%^release-critical/index\.html$%release-critical.html%; + $thing =~ s%/%_%g; + $thgopts =~ s/;/_3B/g; + $thgopts =~ s/=/_3D/g; + return File::Spec->catfile($cachedir, + $thing . $thgopts . ($thing =~ /\.html$/ ? "" : ".html")); +} + +# Given a thing, returns the filename for its mbox in the cache. +sub mboxfile { + my $thing = shift; + return $thing =~ /^\d+$/ + ? File::Spec->catfile($cachedir, $thing . ".mbox") + : undef; +} + +# Given a bug number, returns the dirname for it in the cache. +sub cachebugdir { + my $thing = shift; + if ($thing !~ /^\d+$/) { + die "$progname: cachebugdir given faulty argument: $thing\n"; + } + return File::Spec->catdir($cachedir, $thing); +} + +# And the reverse: Given a filename in the cache, returns the corresponding +# "thing". +sub cachefile_to_thing { + my $thing = basename(shift, '.html'); + my $thgopts = ''; + $thing =~ s/^src_/src:/; + $thing =~ s/^from_/from:/; + $thing =~ s/^tag_/tag:/; + $thing =~ s/^usertag_/usertag:/; + $thing =~ s%^release-critical\.html$%release-critical/index\.html%; + $thing =~ s%_%/%g; + $thing =~ s/_3B/;/g; + $thing =~ s/_3D/=/g; + $thing =~ /^(.*?)((?:;.*)?)$/; + ($thing, $thgopts) = ($1, $2); + return ($thing, $thgopts); +} + +# Given a thing, gives the official BTS cgi page for it +sub thing_to_url { + my $thing = shift; + my $thingurl; + + # have to be intelligent here :/ + if ($thing =~ /^\d+$/) { + $thingurl = $btscgibugurl . "?bug=" . $thing; + } elsif ($thing =~ /^from:/) { + ($thingurl = $thing) =~ s/^from:/submitter=/; + $thingurl = $btscgipkgurl . '?' . $thingurl; + } elsif ($thing =~ /^src:/) { + ($thingurl = $thing) =~ s/^src:/src=/; + $thingurl = $btscgipkgurl . '?' . $thingurl; + } elsif ($thing =~ /^tag:/) { + ($thingurl = $thing) =~ s/^tag:/tag=/; + $thingurl = $btscgipkgurl . '?' . $thingurl; + } elsif ($thing =~ /^usertag:/) { + ($thingurl = $thing) =~ s/^usertag:/tag=/; + $thingurl = $btscgipkgurl . '?' . $thingurl; + } elsif ($thing =~ m%^release-critical(\.html|/(index\.html)?)?$%) { + $thingurl = $btsurl . 'release-critical/index.html'; + } elsif ($thing =~ m%^release-critical/%) { + $thingurl = $btsurl . $thing; + } elsif ($thing =~ /\@/) { # so presume it's a maint request + $thingurl = $btscgipkgurl . '?maint=' . $thing; + } else { # it's a package, or had better be... + $thingurl = $btscgipkgurl . '?pkg=' . $thing; + } + + return $thingurl; +} + +# Given a thing, reads all links to bugs from the corresponding cache file +# if there is one, and returns a list of them. +sub bugs_from_thing { + my $thing = shift; + my $thgopts = shift || ''; + my $cachefile = cachefile($thing, $thgopts); + + if (-f $cachefile) { + local $/; + open(IN, $cachefile) || die "$progname: open $cachefile: $!\n"; + my $data = <IN>; + close IN; + + return $data =~ m!href="(\d+)\.html"!g; + } else { + return (); + } +} + +# Given an <a href="bugreport.cgi?...>...</a> string, return a +# msg id and corresponding filename +sub href_to_filename { + my $href = $_[0]; + my ($msg, $filename); + + if ($href + =~ m%\[<a(?: class=\".*?\")? href="((?:/cgi(?:-bin)?/)?bugreport\.cgi([^\?]*)\?[^\"]*)">.*?\(([^,]*), .*?\)\]% + ) { + # this looks like an attachment; $4 should give the MIME-type + my $uri = URI->new($1); + my $urlfilename = $2; + my $bug = $uri->query_param_delete('bug'); + my $mimetype = $3; + + my $ref = $uri->query(); + $ref =~ s/&(?:amp;)?/;/g; # normalise all hrefs + $uri->query($ref); + + $msg = $uri->query_param('msg'); + my $att = $uri->query_param('att'); + return undef unless $msg && $att; + $msg .= "-$att"; + $urlfilename ||= $att // ''; + + my $fileext = ''; + if ($urlfilename =~ m%^/%) { + $filename = basename($urlfilename); + } else { + $filename = ''; + if ($mimetype eq 'text/plain') { $fileext = '.txt'; } + if ($mimetype eq 'text/html') { $fileext = '.html'; } + } + if (length($filename)) { + $filename = "$bug/$msg/$filename"; + } else { + $filename = "$bug/$msg$fileext"; + } + } elsif ($href + =~ m%<a(?: class=\".*?\")? href="((?:/cgi(?:-bin)?/)?bugreport\.cgi([^\?]*)\?([^"]*))".*?>% + ) { + my $uri = URI->new($1); + my $urlfilename = $2; + my $bug = $uri->query_param_delete('bug'); + $msg = $uri->query_param_delete('msg'); + + my $ref = $uri->query // ''; + $ref =~ s/&(?:amp;)?/;/g; # normalise all hrefs + $ref =~ s/;archive=(yes|no)\b//; + $ref =~ s/%3D/=/g; + $uri->query($ref); + + my %params = ( + mboxstatus => '', + mboxstat => '', + mboxmaint => '', + mbox => '', + $uri->query_form(), + ); + + if ($msg && !%params) { + $filename = File::Spec->catfile($bug, "$msg.html"); + } elsif (($params{mboxstat} || $params{mboxstatus}) eq 'yes') { + $msg = 'statusmbox'; + $filename = "$bug.status.mbox"; + } elsif ($params{mboxmaint} eq 'yes') { + $msg = 'mbox'; + $filename = "$bug.mbox"; + } elsif ($params{mbox} eq 'yes') { + if ($msg) { + $filename = "$bug/$msg.mbox"; + $msg .= '-mbox'; + } else { + $filename = "$bug.raw.mbox"; + $msg = 'rawmbox'; + } + } elsif (!$ref) { + return undef; + } else { + $href =~ s/>.*/>/s; + warn +"$progname: in href_to_filename: unrecognised BTS URL type: $href\n"; + return undef; + } + } elsif ($href + =~ m%<(?:a[^>]* href|img [^>]* src)="((?:/cgi(?:-bin)?/)?version\.cgi\?[^"]+)"[^>]*>%i + ) { + my $uri = URI->new($1); + my %params = $uri->query_form(); + + if ($params{package}) { + $filename .= $params{package}; + } + if ($params{found}) { + $filename .= ".f.$params{found}"; + } + if ($params{fixed}) { + $filename .= ".fx.$params{fixed}"; + } + if ($params{collapse}) { + $filename .= '.co'; + } + + # Replace encoded "/" and "," characters with "." + $filename =~ s@(?:%2[FC]|/|,)@.@gi; + # Remove encoded spaces + $filename =~ s/\+//g; + + $msg = 'versions'; + $filename .= '.png'; + } else { + return undef; + } + + return ($msg, $filename); +} + +# Browses a given thing, with preprocessed list of URL options such as +# ";opt1=val1;opt2=val2" with possible caching if there are no options +sub browse { + prunecache(); + my $thing = shift; + my $thgopts = shift || ''; + + if ($thing eq '') { + if ($thgopts ne '') { + die +"$progname: you can only give options for a BTS page if you specify a bug/maint/... .\n"; + } + runbrowser($btsurl); + return; + } + + my $hascache = -d $cachedir; + my $cachefile = cachefile($thing, $thgopts); + my $mboxfile = mboxfile($thing); + if ($mboxmode and !$mboxfile) { + die +"$progname: you can only request a mailbox for a single bug report.\n"; + } + + # Check that if we're requesting a tag, that it's a valid tag + if (($thing . $thgopts) =~ /(?:^|;)(?:tag|include|exclude)[:=]([^;]*)/) { + unless (exists $valid_tags{$1}) { + die +"$progname: invalid tag requested: $1\nRecognised tag names are: " + . join(" ", @valid_tags) . "\n"; + } + } + + my $livedownload = 1; + if ($offlinemode) { + $livedownload = 0; + if (!$hascache) { + die +"$progname: Sorry, you are in offline mode and have no cache.\nRun \"bts cache\" or \"bts show\" to create one.\n"; + } elsif ((!$mboxmode and !-r $cachefile) + or ($mboxmode and !-r $mboxfile)) { + die +"$progname: Sorry, you are in offline mode and that is not cached.\nUse \"bts [--cache-mode=...] cache\" to update the cache.\n"; + } + if ($mboxmode) { + runmailreader($mboxfile); + } else { + runbrowser("file://$cachefile"); + } + } + # else we're in online mode + elsif ($caching && have_lwp() && $thing ne '') { + if (!$hascache) { + if (!-d dirname($cachedir)) { + unless (make_path(dirname($cachedir))) { + warn "$progname: couldn't mkdir " + . dirname($cachedir) + . ": $!\n"; + goto LIVE; + } + } + unless (make_path($cachedir)) { + warn "$progname: couldn't mkdir $cachedir: $!\n"; + goto LIVE; + } + } + + $livedownload = 0; + my $live = download($thing, $thgopts, 0, $mboxmode); + + if ($mboxmode) { + runmailreader($mboxfile); + } else { + if (length($live)) { + my ($fh, $livefile) = tempfile( + "btsXXXXXX", + SUFFIX => ".html", + DIR => File::Spec->tmpdir, + UNLINK => 1 + ); + + # Use filehandle for security + open(OUT_LIVE, ">&", $fh) + or die "$progname: writing to temporary file: $!\n"; + # Correct relative urls to point to the bts. + $live + =~ s%\shref="(?:/cgi(?:-bin)?/)?(\w+\.cgi)% href="$btscgiurl$1%g; + print OUT_LIVE $live; + # Some browsers don't like unseekable filehandles, + # so use filename + runbrowser("file://$livefile"); + } else { + runbrowser("file://$cachefile"); + } + } + } + + LIVE: # we are not caching; just show it live + if ($livedownload) { + if ($mboxmode) { + # we appear not to be caching; OK, we'll download to a + # temporary file + warn +"bts debug: downloading ${btscgiurl}bugreport.cgi?bug=$thing;mbox=yes\n" + if $debug; + my ($fh, $fn) = download_mbox($thing, 1); + runmailreader($fn); + } else { + if ($thgopts ne '') { + my $thingurl = thing_to_url($thing); + runbrowser($thingurl . $thgopts); + } else { + # let the BTS be intelligent + runbrowser($btsurl . $thing); + } + } + } +} + +# Removes all files from the cache which were downloaded automatically +# and have not been accessed for more than 30 days. We also only run +# this at most once per day for efficiency. + +sub prunecache { + # TODO: Remove handling of $oldcache post-Stretch + my $oldcache = File::Spec->catdir($ENV{HOME}, '.devscripts_cache', 'bts'); + if (-d $oldcache && !-d $cachedir) { + my $err; + make_path(dirname($cachedir), { error => \$err }); + if (!@$err) { + system('mv', $oldcache, $cachedir); + } + } + return unless -d $cachedir; + return if -f $prunestamp and -M _ < 1; + + my $oldcwd = getcwd; + + chdir($cachedir) || die "$progname: chdir $cachedir: $!\n"; + + # remove the now-defunct live-download file + unlink "live_download.html"; + + opendir DIR, '.' or die "$progname: opendir $cachedir: $!\n"; + my @cachefiles = grep { !/^\.\.?$/ } readdir(DIR); + closedir DIR; + + # Are there any unexpected files lying around? + my @known_files = map { basename($_) } + ($timestampdb, $timestampdb . ".lock", $prunestamp); + + my %weirdfiles = map { $_ => 1 } grep { !/\.(html|css|png)$/ } @cachefiles; + foreach (@known_files) { + delete $weirdfiles{$_} if exists $weirdfiles{$_}; + } + # and bug directories + foreach (@cachefiles) { + if (/^(\d+)\.html$/) { + delete $weirdfiles{$1} if exists $weirdfiles{$1} and -d $1; + delete $weirdfiles{"$1.mbox"} + if exists $weirdfiles{"$1.mbox"} and -f "$1.mbox"; + delete $weirdfiles{"$1.raw.mbox"} + if exists $weirdfiles{"$1.raw.mbox"} and -f "$1.raw.mbox"; + delete $weirdfiles{"$1.status.mbox"} + if exists $weirdfiles{"$1.status.mbox"} and -f "$1.status.mbox"; + } + } + + warn "$progname: unexpected files/dirs in cache directory $cachedir:\n " + . join("\n ", keys %weirdfiles) . "\n" + if keys %weirdfiles; + + my @oldfiles; + foreach (@cachefiles) { + next unless /\.(html|css)$/; + push @oldfiles, $_ if -A $_ > 30; + } + + # We now remove the oldfiles if they're automatically downloaded + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDWR() | O_CREAT(), + 0600, $DB_HASH, "write") + or die "$progname: couldn't open DB file $timestampdb for writing: $!\n" + if !tied %timestamp; + + my @unrecognised; + foreach my $oldfile (@oldfiles) { + my ($thing, $thgopts) = cachefile_to_thing($oldfile); + unless (defined get_timestamp($thing, $thgopts)) { + push @unrecognised, $oldfile; + next; + } + next if is_manual(get_timestamp($thing, $thgopts)); + + # Otherwise, it's automatic and we purge it + deletecache($thing, $thgopts); + } + + untie %timestamp; + + if (!-e $prunestamp) { + open PRUNESTAMP, + ">$prunestamp" || die "$progname: prune timestamp: $!\n"; + close PRUNESTAMP; + } + chdir $oldcwd || die "$progname: chdir $oldcwd: $!\n"; + utime time, time, $prunestamp; +} + +# Determines which browser to use +sub runbrowser { + my $URL = shift; + + if (system('sensible-browser', $URL) >> 8 != 0) { + warn "Problem running sensible-browser: $!\n"; + } +} + +# Determines which mailreader to use +sub runmailreader { + my $file = shift; + my $quotedfile; + die "$progname: could not read mbox file $file!\n" unless -r $file; + + if ($file !~ /\'/) { $quotedfile = qq['$file']; } + elsif ($file !~ /[\"\\\$\'\!]/) { $quotedfile = qq["$file"]; } + else { + die +"$progname: could not figure out how to quote the mbox filename \"$file\"\n"; + } + + my $reader = $mailreader; + $reader =~ s/\%([%s])/$1 eq '%' ? '%' : $quotedfile/eg; + + if (system($reader) >> 8 != 0) { + warn "Problem running mail reader: $!\n"; + } +} + +# Timestamp handling +# +# We store a +ve timestamp to represent an automatic download and +# a -ve one to represent a manual download. + +sub get_timestamp { + my $thing = shift; + my $thgopts = shift || ''; + my $timestamp = undef; + my $versionstamp = undef; + + if (tied %timestamp) { + ($timestamp, $versionstamp) = split /;/, + $timestamp{ $thing . $thgopts } + if exists $timestamp{ $thing . $thgopts }; + } else { + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDONLY(), 0600, $DB_HASH, "read") + or die + "$progname: couldn't open DB file $timestampdb for reading: $!\n"; + + ($timestamp, $versionstamp) = split /;/, + $timestamp{ $thing . $thgopts } + if exists $timestamp{ $thing . $thgopts }; + + untie %timestamp; + } + + return wantarray ? ($timestamp, $versionstamp) : $timestamp; +} + +sub set_timestamp { + my $thing = shift; + my $thgopts = shift || ''; + my $timestamp = shift; + my $versionstamp = shift || $version; + + if (tied %timestamp) { + $timestamp{ $thing . $thgopts } = "$timestamp;$versionstamp"; + } else { + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDWR() | O_CREAT(), + 0600, $DB_HASH, "write") + or die + "$progname: couldn't open DB file $timestampdb for writing: $!\n"; + + $timestamp{ $thing . $thgopts } = "$timestamp;$versionstamp"; + + untie %timestamp; + } +} + +sub delete_timestamp { + my $thing = shift; + my $thgopts = shift || ''; + + if (tied %timestamp) { + delete $timestamp{ $thing . $thgopts }; + } else { + tie(%timestamp, "Devscripts::DB_File_Lock", $timestampdb, + O_RDWR() | O_CREAT(), + 0600, $DB_HASH, "write") + or die + "$progname: couldn't open DB file $timestampdb for writing: $!\n"; + + delete $timestamp{ $thing . $thgopts }; + + untie %timestamp; + } +} + +sub is_manual { + return $_[0] < 0; +} + +sub make_manual { + return -abs($_[0]); +} + +sub is_automatic { + return $_[0] > 0; +} + +sub make_automatic { + return abs($_[0]); +} + +# Returns true if current cached version is older than critical version +# We're only using really simple version numbers here: a.b.c +sub old_cache_format_version { + my $cacheversion = $_[0]; + + my @cache = split /\./, $cacheversion; + my @new = split /\./, $new_cache_format_version; + + push @cache, 0, 0, 0, 0; + push @new, 0, 0; + + return + ($cache[0] < $new[0]) + || ($cache[0] == $new[0] && $cache[1] < $new[1]) + || ($cache[0] == $new[0] && $cache[1] == $new[1] && $cache[2] < $new[2]) + || ( $cache[0] == $new[0] + && $cache[1] == $new[1] + && $cache[2] == $new[2] + && $cache[3] < $new[3]); +} + +# We would love to use LWP::Simple::mirror in this script. +# Unfortunately, bugs.debian.org does not respect the +# If-Modified-Since header. For single bug reports, however, +# bugreport.cgi will return a Last-Modified header if sent a HEAD +# request. So this is a hack, based on code from the LWP modules. :-( +# Return value: +# (return value, error string) +# with return values: MIRROR_ERROR failed +# MIRROR_DOWNLOADED downloaded new version +# MIRROR_UP_TO_DATE up-to-date + +sub bts_mirror { + my ($url, $timestamp, $force) = @_; + + init_agent() unless $ua; + if ($url =~ m%/\d+$% and !$refreshmode and !$force) { + # Single bug, worth doing timestamp checks + my $request = HTTP::Request->new('HEAD', $url); + my $response = $ua->request($request); + + if ($response->is_success) { + my $lm = $response->last_modified; + if (defined $lm and $lm <= abs($timestamp)) { + return (MIRROR_UP_TO_DATE, $response->status_line); + } + } else { + return (MIRROR_ERROR, $response->status_line); + } + } + + # So now we download the full thing regardless + # We don't care if we scotch the contents of $file - it's only + # a temporary file anyway + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + + if ($response->is_success) { + # This check from LWP::UserAgent; I don't even know whether + # the BTS sends a Content-Length header... + my $nominal_content_length = $response->content_length || 0; + my $true_content_length + = defined $response->content ? length($response->content) : 0; + if ($true_content_length == 0) { + return (MIRROR_ERROR, $response->status_line); + } + if ($nominal_content_length > 0) { + if ($true_content_length < $nominal_content_length) { + return (MIRROR_ERROR, +"Transfer truncated: only $true_content_length out of $nominal_content_length bytes received" + ); + } + if ($true_content_length > $nominal_content_length) { + return (MIRROR_ERROR, +"Content-length mismatch: expected $nominal_content_length bytes, got $true_content_length" + ); + } + # else OK + } + + return ( + MIRROR_DOWNLOADED, $response->status_line, + $response->content, $response->header('Content-Type')); + } else { + return (MIRROR_ERROR, $response->status_line); + } +} + +sub init_agent { + $ua = new LWP::UserAgent; # we create a global UserAgent object + $ua->agent("LWP::UserAgent/Devscripts/$version"); + $ua->env_proxy; +} + +sub opts_done { + if (@_) { + die "$progname: unknown options to '$command[$index]': @_\n"; + } +} + +sub edit { + my $message = shift; + my ($fh, $filename); + ($fh, $filename) = tempfile( + "btsXXXX", + SUFFIX => ".mail", + DIR => File::Spec->tmpdir + ); + open(OUT_MAIL, ">$filename") + or die "$progname: writing to temporary file: $!\n"; + print OUT_MAIL $message; + close OUT_MAIL; + my $rc = system("sensible-editor $filename"); + undef $message; + + if ($rc == 0) { + open(OUT_MAIL, "<$filename") + or die "$progname: reading from temporary file: $!\n"; + while (<OUT_MAIL>) { + $message .= $_; + } + close OUT_MAIL; + } + unlink($filename); + return $message; +} + +=back + +=head1 ENVIRONMENT VARIABLES + +=over 4 + +=item B<DEBEMAIL> + +If this is set, the From: line in the email will be set to use this email +address instead of your normal email address (as would be determined by +B<mail>). + +=item B<DEBFULLNAME> + +If B<DEBEMAIL> is set, B<DEBFULLNAME> is examined to determine the full name +to use; if this is not set, B<bts> attempts to determine a name from +your F<passwd> entry. + +=item B<BROWSER> + +If set, it specifies the browser to use for the B<show> and B<bugs> +options. See the description above. + +=back + +=head1 CONFIGURATION VARIABLES + +The two configuration files F</etc/devscripts.conf> and +F<~/.devscripts> are sourced by a shell in that order to set +configuration variables. Command line options can be used to override +configuration file settings. Environment variable settings are +ignored for this purpose. The currently recognised variables are: + +=over 4 + +=item B<BTS_OFFLINE> + +If this is set to B<yes>, then it is the same as the B<--offline> command +line parameter being used. Only has an effect on the B<show> and B<bugs> +commands. The default is B<no>. See the description of the B<show> +command above for more information. + +=item B<BTS_CACHE> + +If this is set to B<no>, then it is the same as the B<--no-cache> command +line parameter being used. Only has an effect on the B<show> and B<bug> +commands. The default is B<yes>. Again, see the B<show> command above +for more information. + +=item B<BTS_CACHE_MODE=>{B<min>,B<mbox>,B<full>} + +How much of the BTS should we mirror when we are asked to cache something? +Just the minimum, or also the mbox or the whole thing? The default is +B<min>, and it has the same meaning as the B<--cache-mode> command line +parameter. Only has an effect on the cache. See the B<cache> command for more +information. + +=item B<BTS_FORCE_REFRESH> + +If this is set to B<yes>, then it is the same as the B<--force-refresh> +command line parameter being used. Only has an effect on the B<cache> +command. The default is B<no>. See the B<cache> command for more +information. + +=item B<BTS_MAIL_READER> + +If this is set, specifies a mail reader to use instead of B<mutt>. Same as +the B<--mailreader> command line option. + +=item B<BTS_SENDMAIL_COMMAND> + +If this is set, specifies a B<sendmail> command to use instead of +F</usr/sbin/sendmail>. Same as the B<--sendmail> command line option. + +=item B<BTS_ONLY_NEW> + +Download only new bugs when caching. Do not check for updates in +bugs we already have. The default is B<no>. Same as the B<--only-new> +command line option. + +=item B<BTS_SMTP_HOST> + +If this is set, specifies an SMTP host to use for sending mail rather +than using the B<sendmail> command. Same as the B<--smtp-host> command line +option. + +Note that this option takes priority over B<BTS_SENDMAIL_COMMAND> if both are +set, unless the B<--sendmail> option is used. + +=item B<BTS_SMTP_AUTH_USERNAME>, B<BTS_SMTP_AUTH_PASSWORD> + +If these options are set, then it is the same as the B<--smtp-username> and +B<--smtp-password> options being used. + +=item B<BTS_SMTP_HELO> + +Same as the B<--smtp-helo> command line option. + +=item B<BTS_INCLUDE_RESOLVED> + +If this is set to B<no>, then it is the same as the B<--no-include-resolved> +command line parameter being used. Only has an effect on the B<cache> +command. The default is B<yes>. See the B<cache> command for more +information. + +=item B<BTS_SUPPRESS_ACKS> + +If this is set to B<yes>, then it is the same as the B<--no-ack> command +line parameter being used. The default is B<no>. + +=item B<BTS_INTERACTIVE> + +If this is set to B<yes> or B<force>, then it is the same as the +B<--interactive> or B<--force-interactive> command line parameter being used. +The default is B<no>. + +=item B<BTS_DEFAULT_CC> + +Specify a list of e-mail addresses to which a carbon copy of the generated +e-mail to the control bot should automatically be sent. + +=item B<BTS_SERVER> + +Specify the name of a debbugs server which should be used instead of +https://bugs.debian.org. + +=back + +=head1 SEE ALSO + +Please see L<https://www.debian.org/Bugs/server-control> for +more details on how to control the BTS using emails and +L<https://www.debian.org/Bugs/> for more information about the BTS. + +querybts(1), reportbug(1), pts-subscribe(1), devscripts.conf(5) + +=head1 COPYRIGHT + +This program is Copyright (C) 2001-2003 by Joey Hess <joeyh@debian.org>. +Many modifications have been made, Copyright (C) 2002-2005 Julian +Gilbey <jdg@debian.org> and Copyright (C) 2007 Josh Triplett +<josh@freedesktop.org>. + +It is licensed under the terms of the GPL, either version 2 of the +License, or (at your option) any later version. + +=cut + +# Please leave this alone unless you understand the seek above. +__DATA__ diff --git a/scripts/build-rdeps.pl b/scripts/build-rdeps.pl new file mode 100755 index 0000000..4052ede --- /dev/null +++ b/scripts/build-rdeps.pl @@ -0,0 +1,551 @@ +#!/usr/bin/perl +# -*- tab-width: 4; indent-tabs-mode: t; cperl-indent-level: 4 -*- +# vim: set ai shiftwidth=4 tabstop=4 expandtab: +# Copyright (C) Patrick Schoenfeld +# 2015 Johannes Schauer Marin Rodrigues <josch@debian.org> +# 2017 James McCoy <jamessan@debian.org> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +build-rdeps - find packages that depend on a specific package to build (reverse build depends) + +=head1 SYNOPSIS + +B<build-rdeps> I<package> + +=head1 DESCRIPTION + +B<build-rdeps> searches for all packages that build-depend on the specified package. + +The default behaviour is to just `grep` for the given dependency in the +Build-Depends field of apt's Sources files. + +If the package dose-extra >= 4.0 is installed, then a more complete reverse +build dependency computation is carried out. In particular, with that package +installed, build-rdeps will find transitive reverse dependencies, respect +architecture and build profile restrictions, take Provides relationships, +Conflicts, Pre-Depends, Build-Depends-Arch and versioned dependencies into +account and correctly resolve multiarch relationships for crossbuild reverse +dependency resolution. (This tends to be a slow process due to the complexity +of the package interdependencies.) + +=head1 OPTIONS + +=over 4 + +=item B<-u>, B<--update> + +Run apt-get update before searching for build-depends. + +=item B<-s>, B<--sudo> + +Use sudo when running apt-get update. Has no effect if -u is omitted. + +=item B<--distribution> + +Select another distribution, which is searched for build-depends. + +=item B<--only-main> + +Ignore contrib and non-free + +=item B<--exclude-component> + +Ignore the given component (e.g. main, contrib, non-free). + +=item B<--origin> + +Restrict the search to only the specified origin (such as "Debian"). + +=item B<-m>, B<--print-maintainer> + +Print the value of the maintainer field for each package. + +=item B<--host-arch> + +Explicitly set the host architecture. The default is the value of +`dpkg-architecture -qDEB_HOST_ARCH`. This option only works if dose-extra >= +4.0 is installed. + +=item B<--build-arch> + +Explicitly set the build architecture. The default is the value of +`dpkg-architecture -qDEB_BUILD_ARCH`. This option only works if dose-extra >= +4.0 is installed. + +=item B<--no-arch-all>, B<--no-arch-any> + +Ignore Build-Depends-Indep or Build-Depends-Arch while looking for reverse +dependencies. + +=item B<--old> + +Force the old simple behaviour without dose-ceve support even if dose-extra >= +4.0 is installed. (This tends to be faster.) + +Notice, that the old behaviour only finds direct dependencies, ignores virtual +dependencies, does not find transitive dependencies and does not take version +relationships, architecture restrictions, build profiles or multiarch +relationships into account. + +=item B<--quiet> + +Don't print meta information (header, counter). Making it easier to use in +scripts. + +=item B<-d>, B<--debug> + +Run the debug mode + +=item B<--help> + +Show the usage information. + +=item B<--version> + +Show the version information. + +=back + +=head1 REQUIREMENTS + +The tool requires apt Sources files to be around for the checked components. +In the default case this means that in /var/lib/apt/lists files need to be +around for main, contrib and non-free. + +In practice this means one needs to add one deb-src line for each component, +e.g. + +deb-src http://<mirror>/debian <dist> main contrib non-free + +and run apt-get update afterwards or use the update option of this tool. + +=cut + +use warnings; +use strict; +use File::Basename; +use Getopt::Long qw(:config bundling permute no_getopt_compat); + +use Dpkg::Control; +use Dpkg::Vendor qw(get_current_vendor); + +my $progname = basename($0); +my $version = '1.0'; +my $use_ceve = 0; +my $ceve_compatible; +my $opt_debug; +my $opt_update; +my $opt_sudo; +my $opt_maintainer; +my $opt_mainonly; +my $opt_distribution; +my $opt_origin = 'Debian'; +my @opt_exclude_components; +my $opt_buildarch; +my $opt_hostarch; +my $opt_without_ceve; +my $opt_quiet; +my $opt_noarchall; +my $opt_noarchany; + +sub version { + print <<"EOT"; +This is $progname $version, from the Debian devscripts package, v. ###VERSION### +This code is copyright by Patrick Schoenfeld, all rights reserved. +It comes with ABSOLUTELY NO WARRANTY. You are free to redistribute this code +under the terms of the GNU General Public License, version 2 or later. +EOT + exit(0); +} + +sub usage { + print <<"EOT"; +usage: $progname packagename + $progname --help + $progname --version + +Searches for all packages that build-depend on the specified package. + +Options: + -u, --update Run apt-get update before searching for build-depends. + (needs root privileges) + -s, --sudo Use sudo when running apt-get update + (has no effect when -u is omitted) + -q, --quiet Don't print meta information + -d, --debug Enable the debug mode + -m, --print-maintainer Print the maintainer information (experimental) + --distribution distribution Select a distribution to search for build-depends + (Default: unstable) + --origin origin Select an origin to search for build-depends + (Default: Debian) + --only-main Ignore contrib and non-free + --exclude-component COMPONENT Ignore the specified component (can be given multiple times) + --host-arch Set the host architecture (requires dose-extra >= 4.0) + --build-arch Set the build architecture (requires dose-extra >= 4.0) + --no-arch-all Ignore Build-Depends-Indep + --no-arch-any Ignore Build-Depends-Arch + --old Use the old simple reverse dependency resolution + +EOT + version; +} + +sub test_ceve { + return $ceve_compatible if defined $ceve_compatible; + + # test if the debsrc input and output format is supported by the installed + # ceve version + system('dose-ceve -T debsrc debsrc:///dev/null > /dev/null 2>&1'); + if ($? == -1) { + print STDERR "DEBUG: dose-ceve cannot be executed: $!\n" + if ($opt_debug); + $ceve_compatible = 0; + } elsif ($? == 0) { + $ceve_compatible = 1; + } else { + print STDERR "DEBUG: dose-ceve is too old\n" if ($opt_debug); + $ceve_compatible = 0; + } + return $ceve_compatible; +} + +sub is_devel_release { + my $ctrl = shift; + if (get_current_vendor() eq 'Debian') { + return $ctrl->{Suite} eq 'unstable' || $ctrl->{Codename} eq 'sid'; + } else { + return $ctrl->{Suite} eq 'devel'; + } +} + +sub indextargets { + my @cmd = ('apt-get', 'indextargets', 'DefaultEnabled: yes'); + + if (!$use_ceve) { + # ceve needs both Packages and Sources + push(@cmd, 'Created-By: Sources'); + } + + if ($opt_origin) { + push(@cmd, "Origin: $opt_origin"); + } + + if ($opt_mainonly) { + push(@cmd, 'Component: main'); + } + + print STDERR 'DEBUG: Running ' . join(' ', map { "'$_'" } @cmd) . "\n" + if $opt_debug; + return @cmd; +} + +# Gather information about the available package/source lists. +# +# Returns a hash reference following this structure: +# +# <site> => { +# <suite> => { +# <component> => { +# sources => $src_fname, +# <arch1> => $arch1_fname, +# ..., +# }, +# }, +# ..., +sub collect_files { + my %info = (); + + open(my $targets, '-|', indextargets()); + + until (eof $targets) { + my $ctrl = Dpkg::Control->new(type => CTRL_UNKNOWN); + if (!$ctrl->parse($targets, 'apt-get indextargets')) { + next; + } + # Only need Sources/Packages stanzas + if ( $ctrl->{'Created-By'} ne 'Packages' + && $ctrl->{'Created-By'} ne 'Sources') { + next; + } + + # In expected components + if ( !$opt_mainonly + && exists $ctrl->{Component} + && @opt_exclude_components) { + my $invalid_component = '(?:' + . join('|', map { "\Q$_\E" } @opt_exclude_components) . ')'; + if ($ctrl->{Component} =~ m/$invalid_component/) { + next; + } + } + + # And the provided distribution + if ($opt_distribution) { + if ( $ctrl->{Suite} !~ m/\Q$opt_distribution\E/ + && $ctrl->{Codename} !~ m/\Q$opt_distribution\E/) { + next; + } + } elsif (!is_devel_release($ctrl)) { + next; + } + + $info{ $ctrl->{Site} }{ $ctrl->{Suite} }{ $ctrl->{Component} } ||= {}; + my $ref + = $info{ $ctrl->{Site} }{ $ctrl->{Suite} }{ $ctrl->{Component} }; + + if ($ctrl->{'Created-By'} eq 'Sources') { + $ref->{sources} = $ctrl->{Filename}; + print STDERR "DEBUG: Added source file: $ctrl->{Filename}\n" + if $opt_debug; + } else { + $ref->{ $ctrl->{Architecture} } = $ctrl->{Filename}; + } + } + close($targets); + + return \%info; +} + +sub findreversebuilddeps { + my ($package, $info) = @_; + my $count = 0; + + my $source_file = $info->{sources}; + if ($use_ceve) { + die "build arch undefined" if !defined $opt_buildarch; + die "host arch undefined" if !defined $opt_hostarch; + + my $buildarch_file = $info->{$opt_buildarch}; + my $hostarch_file = $info->{$opt_hostarch}; + + my @ceve_cmd = ( + 'dose-ceve', '-T', + 'debsrc', '-r', + $package, '-G', + 'pkg', "--deb-native-arch=$opt_buildarch", + "deb://$buildarch_file", "debsrc://$source_file" + ); + if ($opt_buildarch ne $opt_hostarch) { + push(@ceve_cmd, + "--deb-host-arch=$opt_hostarch", + "deb://$hostarch_file"); + } + push(@ceve_cmd, "--deb-drop-b-d-indep") if ($opt_noarchall); + push(@ceve_cmd, "--deb-drop-b-d-arch") if ($opt_noarchany); + my %sources; + print STDERR 'DEBUG: executing: ' . join(' ', @ceve_cmd) + if ($opt_debug); + open(SOURCES, '-|', @ceve_cmd); + while (<SOURCES>) { + next unless s/^Package:\s+//; + chomp; + $sources{$_} = 1; + } + for my $source (sort keys %sources) { + print $source; + if ($opt_maintainer) { + my $maintainer + = `apt-cache showsrc $source | grep-dctrl -n -s Maintainer '' | sort -u`; + print " ($maintainer)"; + } + print "\n"; + $count += 1; + } + } else { + open(my $out, '-|', '/usr/lib/apt/apt-helper', 'cat-file', + $source_file) + or die +"$progname: Unable to run \"apt-helper cat-file '$source_file'\": $!"; + + my %packages; + until (eof $out) { + my $ctrl = Dpkg::Control->new(type => CTRL_INDEX_SRC); + if (!$ctrl->parse($out, 'apt-helper cat-file')) { + next; + } + print STDERR "$ctrl\n" if ($opt_debug); + for my $relation ( + qw(Build-Depends Build-Depends-Indep Build-Depends-Arch)) { + if (exists $ctrl->{$relation}) { + if ($ctrl->{$relation} + =~ m/^(.*\s)?\Q$package\E(?::[a-zA-Z0-9][a-zA-Z0-9-]*)?([\s,]|$)/ + ) { + $packages{ $ctrl->{Package} }{Maintainer} + = $ctrl->{Maintainer}; + } + } + } + } + + close($out); + + while (my $depending_package = each(%packages)) { + print $depending_package; + if ($opt_maintainer) { + print " ($packages{$depending_package}->{'Maintainer'})"; + } + print "\n"; + $count += 1; + } + } + + if (!$opt_quiet) { + if ($count == 0) { + print "No reverse build-depends found for $package.\n\n"; + } else { + print +"\nFound a total of $count reverse build-depend(s) for $package.\n\n"; + } + } +} + +if ($#ARGV < 0) { usage; exit(0); } + +GetOptions( + "u|update" => \$opt_update, + "s|sudo" => \$opt_sudo, + "m|print-maintainer" => \$opt_maintainer, + "distribution=s" => \$opt_distribution, + "only-main" => \$opt_mainonly, + "exclude-component=s" => \@opt_exclude_components, + "origin=s" => \$opt_origin, + "host-arch=s" => \$opt_hostarch, + "build-arch=s" => \$opt_buildarch, + "no-arch-all" => \$opt_noarchall, + "no-arch-any" => \$opt_noarchany, + # "profiles=s" => \$opt_profiles, # FIXME: add build profile support + # once dose-ceve has a + # --deb-profiles option + "old" => \$opt_without_ceve, + "q|quiet" => \$opt_quiet, + "d|debug" => \$opt_debug, + "h|help" => sub { usage; }, + "v|version" => sub { version; }) or do { usage; exit 1; }; + +my $package = shift; + +if (!$package) { + die "$progname: missing argument. expecting packagename\n"; +} + +print STDERR "DEBUG: Package => $package\n" if ($opt_debug); + +if ($opt_hostarch) { + if ($opt_without_ceve) { + die +"$progname: the --host-arch option cannot be used together with --old\n"; + } + if (test_ceve()) { + $use_ceve = 1; + } else { + die +"$progname: the --host-arch option requires dose-extra >= 4.0 to be installed\n"; + } +} + +if ($opt_buildarch) { + if ($opt_without_ceve) { + die +"$progname: the --build-arch option cannot be used together with --old\n"; + } + if (test_ceve()) { + $use_ceve = 1; + } else { + die +"$progname: the --build-arch option requires dose-extra >= 4.0 to be installed\n"; + } +} + +# if ceve usage has not been activated yet, check if it can be activated +if (!$use_ceve and !$opt_without_ceve) { + if (test_ceve()) { + $use_ceve = 1; + } else { + print STDERR +"WARNING: dose-extra >= 4.0 is not installed. Falling back to old unreliable behaviour.\n"; + } +} + +if ($use_ceve) { + if (system('command -v grep-dctrl >/dev/null 2>&1')) { + die +"$progname: Fatal error. grep-dctrl is not available.\nPlease install the 'dctrl-tools' package.\n"; + } + + # set hostarch and buildarch if they have not been set yet + if (!$opt_hostarch) { + $opt_hostarch = `dpkg-architecture --query DEB_HOST_ARCH`; + chomp $opt_hostarch; + } + if (!$opt_buildarch) { + $opt_buildarch = `dpkg-architecture --query DEB_BUILD_ARCH`; + chomp $opt_buildarch; + } + print STDERR "DEBUG: running with dose-ceve resolver\n" if ($opt_debug); + print STDERR "DEBUG: buildarch=$opt_buildarch hostarch=$opt_hostarch\n" + if ($opt_debug); +} else { + print STDERR "DEBUG: running with old resolver\n" if ($opt_debug); +} + +if ($opt_update) { + print STDERR "DEBUG: Updating apt-cache before search\n" if ($opt_debug); + my @cmd; + if ($opt_sudo) { + print STDERR "DEBUG: Using sudo to become root\n" if ($opt_debug); + push(@cmd, 'sudo'); + } + push(@cmd, 'apt-get', 'update'); + system @cmd; +} + +my $file_info = collect_files(); + +if (!%{$file_info}) { + die +"$progname: unable to find sources files.\nDid you forget to run apt-get update (or add --update to this command)?"; +} + +foreach my $site (sort keys %{$file_info}) { + foreach my $suite (sort keys %{ $file_info->{$site} }) { + foreach my $comp (qw(main contrib non-free)) { + if (exists $file_info->{$site}{$suite}{$comp}) { + if (!$opt_quiet) { + print "Reverse Build-depends in ${comp}:\n"; + print "------------------------------\n\n"; + } + findreversebuilddeps($package, + $file_info->{$site}{$suite}{$comp}); + } + } + } +} + +=head1 LICENSE + +This code is copyright by Patrick Schoenfeld +<schoenfeld@debian.org>, all rights reserved. +This program comes with ABSOLUTELEY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. + +=head1 AUTHOR + +Patrick Schoenfeld <schoenfeld@debian.org> + +=cut diff --git a/scripts/chdist.bash_completion b/scripts/chdist.bash_completion new file mode 100644 index 0000000..51dbf49 --- /dev/null +++ b/scripts/chdist.bash_completion @@ -0,0 +1,60 @@ +# /usr/share/bash-completion/completions/chdist +# Bash command completion for ‘chdist(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +_chdist () +{ + local cur=$2 prev=$3 + local options='--help -h --data-dir -d --arch -a' + local commands='create apt apt-get apt-cache apt-rdepends aptitude + src2bin bin2src + compare-packages compare-bin-packages + compare-versions compare-bin-versions + grep-dctrl-packages grep-dctrl-sources + list' + # Sync'd with buildd.debian.org on 2016-04-02: + local archs="all alpha amd64 arm64 armel armhf hppa hurd-i386 i386 ia64 kfreebsd-amd64 kfreebsd-i386 m68k mips mips64el mipsel powerpc powerpcspe ppc64 ppc64el s390 s390x sh4 sparc sparc64 x32" + local dists=$(ls ~/.chdist 2>/dev/null) + + COMPREPLY=() + + + case "$prev" in + -@(-arch|a)) + COMPREPLY=( $( compgen -W "$archs" -- $cur ) ) + return 0 + ;; + -@(-data-dir|d)) + _filedir + return 0 + ;; + -@(-help|h)|list) + return 0 + ;; + create|apt|apt-get|apt-cache|apt-rdepends|aptitude|src2bin|bin2src|compare-packages|compare-bin-packages|compare-versions|compare-bin-versions|grep-dctrl-packages|grep-dctrl-sources) + COMPREPLY=( $( compgen -W "$dists" -- $cur ) ) + return 0 + esac + + if [[ "$cur" == -* ]]; then + # return one of the possible options + COMPREPLY=( $( compgen -W "$options" -- $cur ) ) + else + # return one of the possible commands + COMPREPLY=( $( compgen -W "$commands" -- $cur ) ) + fi + + return 0 + +} + + +complete -F _chdist chdist + + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/chdist.pl b/scripts/chdist.pl new file mode 100755 index 0000000..057994a --- /dev/null +++ b/scripts/chdist.pl @@ -0,0 +1,780 @@ +#!/usr/bin/perl + +# Debian GNU/Linux chdist. Copyright (C) 2007 Lucas Nussbaum and Luk Claes. +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +=head1 NAME + +chdist - script to easily play with several distributions + +=head1 SYNOPSIS + +B<chdist> [I<options>] [I<command>] [I<command parameters>] + +=head1 DESCRIPTION + +B<chdist> is a rewrite of what used to be known as 'MultiDistroTools' +(or mdt). Its use is to create 'APT trees' for several distributions, +making it easy to query the status of packages in other distribution +without using chroots, for instance. + +=head1 OPTIONS + +=over 4 + +=item B<-h>, B<--help> + +Provide a usage message. + +=item B<-d>, B<--data-dir> I<DIR> + +Choose data directory (default: F<~/.chdist/>). + +=item B<-a>, B<--arch> I<ARCH> + +Choose architecture (default: `B<dpkg --print-architecture>`). + +=item B<--version> + +Display version information. + +=back + +=head1 COMMANDS + +=over 4 + +=item B<create> I<DIST> [I<URL> I<RELEASE> I<SECTIONS>] + +Prepare a new tree named I<DIST> + +=item B<apt> I<DIST> <B<update>|B<source>|B<show>|B<showsrc>|...> + +Run B<apt> inside I<DIST> + +=item B<apt-get> I<DIST> <B<update>|B<source>|...> + +Run B<apt-get> inside I<DIST> + +=item B<apt-cache> I<DIST> <B<show>|B<showsrc>|...> + +Run B<apt-cache> inside I<DIST> + +=item B<apt-file> I<DIST> <B<update>|B<search>|...> + +Run B<apt-file> inside I<DIST> + +=item B<apt-rdepends> I<DIST> [...] + +Run B<apt-rdepends> inside I<DIST> + +=item B<aptitude> I<DIST> [...] + +Run B<aptitude> inside I<DIST> + +=item B<src2bin> I<DIST SRCPKG> + +List binary packages for I<SRCPKG> in I<DIST> + +=item B<bin2src> I<DIST BINPKG> + +List source package for I<BINPKG> in I<DIST> + +=item B<compare-packages> I<DIST1 DIST2> [I<DIST3>, ...] + +=item B<compare-bin-packages> I<DIST1 DIST2> [I<DIST3>, ...] + +List versions of packages in several I<DIST>ributions + +=item B<compare-versions> I<DIST1 DIST2> + +=item B<compare-bin-versions> I<DIST1 DIST2> + +Same as B<compare-packages>/B<compare-bin-packages>, but also runs +B<dpkg --compare-versions> and display where the package is newer. + +=item B<compare-src-bin-packages> I<DIST> + +Compare sources and binaries for I<DIST> + +=item B<compare-src-bin-versions> I<DIST> + +Same as B<compare-src-bin-packages>, but also run B<dpkg --compare-versions> +and display where the package is newer + +=item B<grep-dctrl-packages> I<DIST> [...] + +Run B<grep-dctrl> on F<*_Packages> inside I<DIST> + +=item B<grep-dctrl-sources> I<DIST> [...] + +Run B<grep-dctrl> on F<*_Sources> inside I<DIST> + +=item B<list> + +List available I<DIST>s + +=back + +=head1 COPYRIGHT + +This program is copyright 2007 by Lucas Nussbaum and Luk Claes. This +program comes with ABSOLUTELY NO WARRANTY. + +It is licensed under the terms of the GPL, either version 2 of the +License, or (at your option) any later version. + +=cut + +use strict; +use warnings; +no if $] >= 5.018, 'warnings', 'experimental::smartmatch'; +use feature 'switch'; +use File::Copy qw(cp); +use File::HomeDir; +use File::Path qw(make_path); +use File::Basename; +use Getopt::Long qw(:config gnu_compat bundling require_order); +use Cwd qw(abs_path cwd); +use Dpkg::Version qw(version_compare); +use Pod::Usage; + +# Redefine Pod::Text's cmd_i so pod2usage converts I<...> to <...> instead of +# *...* +{ + + package Pod::Text; + no warnings qw(redefine); + + sub cmd_i { '<' . $_[2] . '>' } +} + +my $progname = basename($0); + +sub usage { + pod2usage( + -verbose => 99, + -exitval => $_[0], + -sections => 'SYNOPSIS|OPTIONS|ARGUMENTS|COMMANDS' + ); +} + +# specify the options we accept and initialize +# the option parser +my $help = ''; + +my $version = ''; +my $versioninfo = <<"EOF"; +This is $progname, from the Debian devscripts package, version +###VERSION### This code is copyright 2007 by Lucas Nussbaum and Luk +Claes. This program comes with ABSOLUTELY NO WARRANTY. You are free +to redistribute this code under the terms of the GNU General Public +License, version 2 or (at your option) any later version. +EOF + +my $arch; +my $datadir = File::HomeDir->my_home . '/.chdist'; + +GetOptions( + "h|help" => \$help, + "d|data-dir=s" => \$datadir, + "a|arch=s" => \$arch, + "version" => \$version, +) or usage(1); + +# Fix-up relative paths +$datadir = cwd() . "/$datadir" if $datadir !~ m!^/!; +$datadir = abs_path($datadir); + +if ($help) { + usage(0); +} + +if ($version) { + print $versioninfo; + exit 0; +} + +######################################################## +### Functions +######################################################## + +sub fatal { + my ($msg) = @_; + $msg =~ s/\n?$/\n/; + print STDERR "$progname: $msg"; + exit 1; +} + +sub uniq (@) { + my %hash; + map { $hash{$_}++ == 0 ? $_ : () } @_; +} + +sub dist_check { + # Check that dist exists in $datadir + my ($dist) = @_; + if ($dist) { + my $dir = "$datadir/$dist"; + return 0 if (-d $dir); + fatal( +"Could not find $dist in $datadir. Run `$progname create $dist` first." + ); + } else { + fatal('No dist provided.'); + } +} + +sub type_check { + my ($type) = @_; + if (($type ne 'Sources') && ($type ne 'Packages')) { + fatal("Unknown type $type."); + } +} + +sub aptopts { + # Build apt options + my ($dist) = @_; + my @opts = (); + if ($arch) { + print "W: Forcing arch $arch for this command only.\n"; + push(@opts, '-o', "Apt::Architecture=$arch"); + push(@opts, '-o', "Apt::Architectures=$arch"); + } + return @opts; +} + +sub aptconfig { + # Build APT_CONFIG override + my ($dist) = @_; + my $aptconf = "$datadir/$dist/etc/apt/apt.conf"; + if (!-r $aptconf) { + fatal("Unable to read $aptconf"); + } + $ENV{'APT_CONFIG'} = $aptconf; +} + +### + +sub aptcmd { + my ($cmd, $dist, @args) = @_; + dist_check($dist); + unshift(@args, aptopts($dist)); + aptconfig($dist); + exec($cmd, @args); +} + +sub apt_file { + my ($dist, @args) = @_; + dist_check($dist); + aptconfig($dist); + my @query = ('dpkg-query', '-W', '-f'); + open(my $fd, '-|', @query, '${Version}', 'apt-file') + or fatal('Unable to run dpkg-query.'); + my $aptfile_version = <$fd>; + close($fd); + if (version_compare('3.0~', $aptfile_version) < 0) { + open($fd, '-|', @query, '${Conffiles}\n', 'apt-file') + or fatal('Unable to run dpkg-query.'); + my @aptfile_confs = map { (split)[0] } + grep { /apt\.conf\.d/ } <$fd>; + close($fd); + # New-style apt-file + for my $conffile (@aptfile_confs) { + if (!-f "$datadir/$dist/$conffile") { + cp($conffile, "$datadir/$dist/$conffile"); + } + } + } else { + my $cache_directory + = $datadir . '/' . $dist . "/var/cache/apt/apt-file"; + unshift(@args, '--cache', $cache_directory); + } + exec('apt-file', @args); +} + +sub bin2src { + my ($dist, $pkg) = @_; + dist_check($dist); + if (!defined($pkg)) { + fatal("No package name provided. Exiting."); + } + my @args = (aptopts($dist), 'show', $pkg); + aptconfig($dist); + my $src = $pkg; + my $pid = open(CACHE, '-|', 'apt-cache', @args); + if (!defined($pid)) { + fatal("Couldn't run apt-cache: $!"); + } + if ($pid) { + while (<CACHE>) { + if (m/^Source: (.*)/) { + $src = $1; + # Slurp remaining output to avoid SIGPIPE + local $/ = undef; + my $junk = <CACHE>; + last; + } + } + close CACHE || fatal("bad apt-cache $!: $?"); + print "$src\n"; + } +} + +sub src2bin { + my ($dist, $pkg) = @_; + dist_check($dist); + if (!defined($pkg)) { + fatal("no package name provided. Exiting."); + } + my @args = (aptopts($dist), 'showsrc', $pkg); + aptconfig($dist); + my $pid = open(CACHE, '-|', 'apt-cache', @args); + if (!defined($pid)) { + fatal("Couldn't run apt-cache: $!"); + } + if ($pid) { + while (<CACHE>) { + if (m/^Binary: (.*)/) { + print join("\n", split(/, /, $1)) . "\n"; + # Slurp remaining output to avoid SIGPIPE + local $/ = undef; + my $junk = <CACHE>; + last; + } + } + close CACHE || fatal("bad apt-cache $!: $?"); + } +} + +sub dist_create { + my ($dist, $method, $version, @sections) = @_; + if (!defined($dist)) { + fatal("you must provide a dist name."); + } + my $dir = "$datadir/$dist"; + if (-d $dir) { + fatal("$dir already exists, exiting."); + } + make_path($datadir); + foreach my $d (( + '/etc/apt', '/etc/apt/apt.conf.d', + '/etc/apt/preferences.d', '/etc/apt/trusted.gpg.d', + '/etc/apt/sources.list.d', '/var/lib/apt/lists/partial', + '/var/cache/apt/archives/partial', '/var/lib/dpkg' + ) + ) { + make_path("$dir/$d"); + } + + # Create sources.list + open(FH, '>', "$dir/etc/apt/sources.list"); + if ($version) { + # Use provided method, version and sections + my $sections_str = join(' ', @sections); + print FH <<EOF; +deb $method $version $sections_str +deb-src $method $version $sections_str +EOF + } else { + if ($method) { + warn +"W: method provided without a section. Using default content for sources.list\n"; + } + # Fill in sources.list with example contents + print FH <<EOF; +#deb http://deb.debian.org/debian/ unstable main contrib non-free +#deb-src http://deb.debian.org/debian/ unstable main contrib non-free + +#deb http://archive.ubuntu.com/ubuntu dapper main restricted +#deb http://archive.ubuntu.com/ubuntu dapper universe multiverse +#deb-src http://archive.ubuntu.com/ubuntu dapper main restricted +#deb-src http://archive.ubuntu.com/ubuntu dapper universe multiverse +EOF + } + close FH; + # Create dpkg status + open(FH, '>', "$dir/var/lib/dpkg/status"); + close FH; #empty file + # Create apt.conf + $arch ||= `dpkg --print-architecture`; + chomp $arch; + open(FH, ">$dir/etc/apt/apt.conf"); + print FH <<EOF; +Apt { + Architecture "$arch"; + Architectures "$arch"; +}; + +Dir "$dir"; +EOF + close FH; + + foreach my $keyring ( + qw(debian-archive-keyring.gpg + debian-archive-removed-keys.gpg + ubuntu-archive-keyring.gpg + ubuntu-archive-removed-keys.gpg) + ) { + my $src = "/usr/share/keyrings/$keyring"; + if (-f $src) { + symlink $src, "$dir/etc/apt/trusted.gpg.d/$keyring"; + } + } + print "Now edit $dir/etc/apt/sources.list\n" unless $version; + print "Run chdist apt $dist update\n"; + print "And enjoy.\n"; +} + +sub get_distfiles { + # Retrieve files to be read + # Takes a dist and a type + my ($dist, $type) = @_; + + my @files; + + foreach + my $file (glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$type")) { + if (-f $file) { + push @files, $file; + } + } + + return \@files; +} + +sub dist_compare(\@$$) { + # Takes a list of dists, a type of comparison and a do_compare flag + my ($dists, $do_compare, $type) = @_; + type_check($type); + + # Get the list of dists from the reference + my @dists = @$dists; + map { dist_check($_) } @dists; + + # Get all packages + my %packages; + + foreach my $dist (@dists) { + my $files = get_distfiles($dist, $type); + my @files = @$files; + foreach my $file (@files) { + my $parsed_file = parseFile($file); + foreach my $package (keys(%{$parsed_file})) { + if ($packages{$dist}{$package}) { + my $version = $packages{$dist}{$package}{Version}; + my $alt_ver = $parsed_file->{$package}{Version}; + my $delta + = $version + && $alt_ver + && version_compare($version, $alt_ver); + if (defined($delta) && $delta < 0) { + $packages{$dist}{$package} = $parsed_file->{$package}; + } else { + warn +"W: Package $package is already listed for $dist. Not overriding.\n"; + } + } else { + $packages{$dist}{$package} = $parsed_file->{$package}; + } + } + } + } + + # Get entire list of packages + my @all_packages = uniq sort (map { keys(%{ $packages{$_} }) } @dists); + + foreach my $package (@all_packages) { + my $line = "$package "; + my $status = ""; + my $details; + + foreach my $dist (@dists) { + if ($packages{$dist}{$package}) { + $line .= "$packages{$dist}{$package}{'Version'} "; + } else { + $line .= "UNAVAIL "; + $status = "not_in_$dist"; + } + } + + my @versions = map { $packages{$_}{$package}{'Version'} } @dists; + # Escaped versions + my @esc_vers = @versions; + foreach my $vers (@esc_vers) { + $vers =~ s|\+|\\\+| if defined $vers; + } + + # Do compare + if ($do_compare) { + if (!@dists) { + fatal('Can only compare versions if there are two distros.'); + } + if (!$status) { + my $cmp = version_compare($versions[0], $versions[1]); + if (!$cmp) { + $status = "same_version"; + } elsif ($cmp < 0) { + $status = "newer_in_$dists[1]"; + if ($versions[1] =~ m|^$esc_vers[0]|) { + $details = " local_changes_in_$dists[1]"; + } + } else { + $status = "newer_in_$dists[0]"; + if ($versions[0] =~ m|^$esc_vers[1]|) { + $details = " local_changes_in_$dists[0]"; + } + } + } + $line .= " $status $details"; + } + + print "$line\n"; + } +} + +sub compare_src_bin { + my ($dist, $do_compare) = @_; + + dist_check($dist); + + # Get all packages + my %packages; + my @parse_types = ('Sources', 'Packages'); + my @comp_types = ('Sources_Bin', 'Packages'); + + foreach my $type (@parse_types) { + my $files = get_distfiles($dist, $type); + my @files = @$files; + foreach my $file (@files) { + my $parsed_file = parseFile($file); + foreach my $package (keys(%{$parsed_file})) { + if ($packages{$dist}{$package}) { + warn +"W: Package $package is already listed for $dist. Not overriding.\n"; + } else { + $packages{$type}{$package} = $parsed_file->{$package}; + } + } + } + } + + # Build 'Sources_Bin' hash + foreach my $package (keys(%{ $packages{Sources} })) { + my $package_h = \%{ $packages{Sources}{$package} }; + if ($package_h->{'Binary'}) { + my @binaries = split(", ", $package_h->{'Binary'}); + my $version = $package_h->{'Version'}; + foreach my $binary (@binaries) { + if (defined $packages{Sources_Bin}{$binary}) { + my $alt_ver = $packages{Sources_Bin}{$binary}{Version}; + # Skip this entry if it's an older version than we already + # have + if (version_compare($version, $alt_ver) < 0) { + next; + } + } + $packages{Sources_Bin}{$binary}{Version} = $version; + } + } else { + warn "Source $package has no binaries!\n"; + } + } + + # Get entire list of packages + my @all_packages + = uniq sort (map { keys(%{ $packages{$_} }) } @comp_types); + + foreach my $package (@all_packages) { + my $line = "$package "; + my $status = ""; + my $details = ''; + + foreach my $type (@comp_types) { + if ($packages{$type}{$package}) { + $line .= "$packages{$type}{$package}{'Version'} "; + } else { + $line .= "UNAVAIL "; + $status = "not_in_$type"; + } + } + + my @versions = map { $packages{$_}{$package}{'Version'} } @comp_types; + + # Do compare + if ($do_compare) { + if (!@comp_types) { + fatal('Can only compare versions if there are two types.'); + } + if (!$status) { + my $cmp = version_compare($versions[0], $versions[1]); + if (!$cmp) { + $status = "same_version"; + } elsif ($cmp < 0) { + $status = "newer_in_$comp_types[1]"; + if ($versions[1] =~ m|^\Q$versions[0]\E|) { + $details = " local_changes_in_$comp_types[1]"; + } + } else { + $status = "newer_in_$comp_types[0]"; + if ($versions[0] =~ m|^\Q$versions[1]\E|) { + $details = " local_changes_in_$comp_types[0]"; + } + } + } + $line .= " $status $details"; + } + + print "$line\n"; + } +} + +sub grep_file(\@$) { + my ($argv, $file) = @_; + my $dist = shift @{$argv}; + dist_check($dist); + my @f = glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$file"); + if (@f) { + exec('grep-dctrl', @{$argv}, @f); + } else { + fatal("Couldn't find a $file for $dist."); + } +} + +sub list { + opendir(DIR, $datadir) or fatal("can't open dir $datadir: $!"); + while (my $file = readdir(DIR)) { + if ((-d "$datadir/$file") && ($file =~ m|^\w+|)) { + print "$file\n"; + } + } + closedir(DIR); +} + +sub parseFile { + my ($file) = @_; + + # Parse a source file and returns results as a hash + + open(FILE, '<', $file) || fatal("Could not open $file : $!"); + + # Use %tmp hash to store tmp data + my %tmp; + my %result; + + while (my $line = <FILE>) { + if ($line =~ m|^$|) { + # Commit data if empty line + if ($tmp{'Package'}) { + #print "Committing data for $tmp{'Package'}\n"; + while (my ($field, $data) = each(%tmp)) { + if ($field ne "Package") { + $result{ $tmp{'Package'} }{$field} = $data; + } + } + # Reset %tmp + %tmp = (); + } else { + warn "W: No Package field found. Not committing data.\n"; + } + } elsif ($line =~ m|^[a-zA-Z]|) { + # Gather data + my ($field, $data) = $line =~ m|([a-zA-Z-]+): (.*)$|; + if ($data) { + $tmp{$field} = $data; + } + } + } + close(FILE); + + return \%result; +} + +######################################################## +### Command parsing +######################################################## + +my $recursed = 0; +MAIN: +my $command = shift @ARGV; +given ($command) { + when ('create') { + dist_create(@ARGV); + } + when ('apt') { + aptcmd('apt', @ARGV); + } + when ('apt-get') { + aptcmd('apt-get', @ARGV); + } + when ('apt-cache') { + aptcmd('apt-cache', @ARGV); + } + when ('apt-file') { + apt_file(@ARGV); + } + when ('apt-rdepends') { + aptcmd('apt-rdepends', @ARGV); + } + when ('aptitude') { + aptcmd('aptitude', @ARGV); + } + when ('bin2src') { + bin2src(@ARGV); + } + when ('src2bin') { + src2bin(@ARGV); + } + when ('compare-packages') { + dist_compare(@ARGV, 0, 'Sources'); + } + when ('compare-bin-packages') { + dist_compare(@ARGV, 0, 'Packages'); + } + when ('compare-versions') { + dist_compare(@ARGV, 1, 'Sources'); + } + when ('compare-bin-versions') { + dist_compare(@ARGV, 1, 'Packages'); + } + when ('grep-dctrl-packages') { + grep_file(@ARGV, 'Packages'); + } + when ('grep-dctrl-sources') { + grep_file(@ARGV, 'Sources'); + } + when ('compare-src-bin-packages') { + compare_src_bin(@ARGV, 0); + } + when ('compare-src-bin-versions') { + compare_src_bin(@ARGV, 1); + } + when ('list') { + list; + } + default { + my $dist = $command; + my $dir = "$datadir/$dist"; + if (-d $dir && !$recursed) { + splice @ARGV, 1, 0, $dist; + $recursed = 1; + goto MAIN; + } elsif ($dist && !$recursed) { + dist_check($dist); + } else { + usage(1); + } + } +} diff --git a/scripts/checkbashisms.1 b/scripts/checkbashisms.1 new file mode 100644 index 0000000..1075408 --- /dev/null +++ b/scripts/checkbashisms.1 @@ -0,0 +1,71 @@ +.TH CHECKBASHISMS 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +checkbashisms \- check for bashisms in /bin/sh scripts +.SH SYNOPSIS +\fBcheckbashisms\fR \fIscript\fR ... +.br +\fBcheckbashisms \-\-help\fR|\fB\-\-version\fR +.SH DESCRIPTION +\fBcheckbashisms\fR, based on one of the checks from the \fBlintian\fR +system, performs basic checks on \fI/bin/sh\fR shell scripts for the +possible presence of bashisms. It takes the names of the shell +scripts on the command line, and outputs warnings if possible bashisms +are detected. +.PP +Note that the definition of a bashism in this context roughly equates +to "a shell feature that is not required to be supported by POSIX"; this +means that some issues flagged may be permitted under optional sections +of POSIX, such as XSI or User Portability. +.PP +In cases where POSIX and Debian Policy disagree, \fBcheckbashisms\fR by +default allows extensions permitted by Policy but may also provide +options for stricter checking. +.SH OPTIONS +.TP +.BR \-\-help ", " \-h +Show a summary of options. +.TP +.BR \-\-newline ", " \-n +Check for "\fBecho \-n\fR" usage (non POSIX but required by Debian Policy 10.4.) +.TP +.BR \-\-posix ", " \-p +Check for issues which are non POSIX but required to be supported by Debian +Policy 10.4 (implies \fB\-n\fR). +.TP +.BR \-\-force ", " \-f +Force each script to be checked, even if it would normally not be (for +instance, it has a bash or non POSIX shell shebang or appears to be a +shell wrapper). +.TP +.BR \-\-extra ", " \-x +Highlight lines which, whilst they do not contain bashisms, may be +useful in determining whether a particular issue is a false positive +which may be ignored. +For example, the use of "\fB$BASH_ENV\fR" may be preceded by checking +whether "\fB$BASH\fR" is set. +.TP +.BR \-\-early-fail ", " \-e +Exit right after a first error is seen. +.TP +.BR \-\-version ", " \-v +Show version and copyright information. +.SH "EXIT VALUES" +The exit value will be 0 if no possible bashisms or other problems +were detected. Otherwise it will be the sum of the following error +values: +.TP +1 +A possible bashism was detected. +.TP +2 +A file was skipped for some reason, for example, because it was +unreadable or not found. The warning message will give details. +.TP +4 +No bashisms were detected in a bash script. +.SH "SEE ALSO" +.BR lintian (1) +.SH AUTHOR +\fBcheckbashisms\fR was originally written as a shell script by Yann Dirson +<\fIdirson@debian.org\fR> and rewritten in Perl with many more features by +Julian Gilbey <\fIjdg@debian.org\fR>. diff --git a/scripts/checkbashisms.bash_completion b/scripts/checkbashisms.bash_completion new file mode 100644 index 0000000..b0e30fd --- /dev/null +++ b/scripts/checkbashisms.bash_completion @@ -0,0 +1,28 @@ +# /usr/share/bash-completion/completions/checkbashisms +# Bash command completion for ‘checkbashisms(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +# Copyright © 2015, Nicholas Bamber <nicholas@periapt.co.uk> + +_checkbashisms() +{ + local cur prev words cword special + _init_completion || return + + if [[ "$cur" == -* ]]; then + COMPREPLY=( $( compgen -W '--newline --posix --force --extra --early-fail' -- "$cur" ) ) + else + COMPREPLY=( $( compgen -o filenames -f -- "$cur" ) ) + fi + + return 0 +} && +complete -F _checkbashisms checkbashisms + + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/checkbashisms.pl b/scripts/checkbashisms.pl new file mode 100755 index 0000000..568e2c3 --- /dev/null +++ b/scripts/checkbashisms.pl @@ -0,0 +1,816 @@ +#!/usr/bin/perl + +# This script is essentially copied from /usr/share/lintian/checks/scripts, +# which is: +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# This version is +# Copyright (C) 2003 Julian Gilbey +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +use strict; +use warnings; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use File::Temp qw/tempfile/; + +sub init_hashes; + +(my $progname = $0) =~ s|.*/||; + +my $usage = <<"EOF"; +Usage: $progname [-n] [-f] [-x] [-e] script ... + or: $progname --help + or: $progname --version +This script performs basic checks for the presence of bashisms +in /bin/sh scripts and the lack of bashisms in /bin/bash ones. +EOF + +my $version = <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 2003 by Julian Gilbey <jdg\@debian.org>, +based on original code which is copyright 1998 by Richard Braakman +and copyright 2002 by Josip Rodin. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2, or (at your option) any later version. +EOF + +my ($opt_echo, $opt_force, $opt_extra, $opt_posix, $opt_early_fail); +my ($opt_help, $opt_version); +my @filenames; + +# Detect if STDIN is a pipe +if (scalar(@ARGV) == 0 && (-p STDIN or -f STDIN)) { + push(@ARGV, '-'); +} + +## +## handle command-line options +## +$opt_help = 1 if int(@ARGV) == 0; + +GetOptions( + "help|h" => \$opt_help, + "version|v" => \$opt_version, + "newline|n" => \$opt_echo, + "force|f" => \$opt_force, + "extra|x" => \$opt_extra, + "posix|p" => \$opt_posix, + "early-fail|e" => \$opt_early_fail, + ) + or die +"Usage: $progname [options] filelist\nRun $progname --help for more details\n"; + +if ($opt_help) { print $usage; exit 0; } +if ($opt_version) { print $version; exit 0; } + +$opt_echo = 1 if $opt_posix; + +my $mode = 0; +my $issues = 0; +my $status = 0; +my $makefile = 0; +my (%bashisms, %string_bashisms, %singlequote_bashisms); + +my $LEADIN + = qr'(?:(?:^|[`&;(|{])\s*|(?:(?:if|elif|while)(?:\s+!)?|then|do|shell)\s+)'; +init_hashes; + +my @bashisms_keys = sort keys %bashisms; +my @string_bashisms_keys = sort keys %string_bashisms; +my @singlequote_bashisms_keys = sort keys %singlequote_bashisms; + +foreach my $filename (@ARGV) { + my $check_lines_count = -1; + + my $display_filename = $filename; + + if ($filename eq '-') { + my $tmp_fh; + ($tmp_fh, $filename) + = tempfile("chkbashisms_tmp.XXXX", TMPDIR => 1, UNLINK => 1); + while (my $line = <STDIN>) { + print $tmp_fh $line; + } + close($tmp_fh); + $display_filename = "(stdin)"; + } + + if (!$opt_force) { + $check_lines_count = script_is_evil_and_wrong($filename); + } + + if ($check_lines_count == 0 or $check_lines_count == 1) { + warn +"script $display_filename does not appear to be a /bin/sh script; skipping\n"; + next; + } + + if ($check_lines_count != -1) { + warn +"script $display_filename appears to be a shell wrapper; only checking the first " + . "$check_lines_count lines\n"; + } + + unless (open C, '<', $filename) { + warn "cannot open script $display_filename for reading: $!\n"; + $status |= 2; + next; + } + + $issues = 0; + $mode = 0; + my $cat_string = ""; + my $cat_indented = 0; + my $quote_string = ""; + my $last_continued = 0; + my $continued = 0; + my $found_rules = 0; + my $buffered_orig_line = ""; + my $buffered_line = ""; + my %start_lines; + + while (<C>) { + next unless ($check_lines_count == -1 or $. <= $check_lines_count); + + if ($. == 1) { # This should be an interpreter line + if (m,^\#!\s*(?:\S+/env\s+)?(\S+),) { + my $interpreter = $1; + + if ($interpreter =~ m,(?:^|/)make$,) { + init_hashes if !$makefile++; + $makefile = 1; + } else { + init_hashes if $makefile--; + $makefile = 0; + } + next if $opt_force; + + if ($interpreter =~ m,(?:^|/)bash$,) { + $mode = 1; + } elsif ($interpreter !~ m,(?:^|/)(sh|dash|posh)$,) { +### ksh/zsh? + warn +"script $display_filename does not appear to be a /bin/sh script; skipping\n"; + $status |= 2; + last; + } + } else { + warn +"script $display_filename does not appear to have a \#! interpreter line;\nyou may get strange results\n"; + } + } + + chomp; + my $orig_line = $_; + + # We want to remove end-of-line comments, so need to skip + # comments that appear inside balanced pairs + # of single or double quotes + + # Remove comments in the "quoted" part of a line that starts + # in a quoted block? The problem is that we have no idea + # whether the program interpreting the block treats the + # quote character as part of the comment or as a quote + # terminator. We err on the side of caution and assume it + # will be treated as part of the comment. + # s/^(?:.*?[^\\])?$quote_string(.*)$/$1/ if $quote_string ne ""; + + # skip comment lines + if ( m,^\s*\#, + && $quote_string eq '' + && $buffered_line eq '' + && $cat_string eq '') { + next; + } + + # Remove quoted strings so we can more easily ignore comments + # inside them + s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If inside a quoted string, remove everything before the quote + s/^.+?\'// + if ($quote_string eq "'"); + s/^.+?[^\\]\"// + if ($quote_string eq '"'); + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing. + if (m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + $_ = $orig_line; + s/\Q$1\E//; # eat comments + } else { + $_ = $orig_line; + } + + # Handle line continuation + if (!$makefile && $cat_string eq '' && m/\\$/) { + chop; + $buffered_line .= $_; + $buffered_orig_line .= $orig_line . "\n"; + next; + } + + if ($buffered_line ne '') { + $_ = $buffered_line . $_; + $orig_line = $buffered_orig_line . $orig_line; + $buffered_line = ''; + $buffered_orig_line = ''; + } + + if ($makefile) { + $last_continued = $continued; + if (/[^\\]\\$/) { + $continued = 1; + } else { + $continued = 0; + } + + # Don't match lines that look like a rule if we're in a + # continuation line before the start of the rules + if (/^[\w%-]+:+\s.*?;?(.*)$/ + and !($last_continued and !$found_rules)) { + $found_rules = 1; + $_ = $1 if $1; + } + + last + if m%^\s*(override\s|export\s)?\s*SHELL\s*:?=\s*(/bin/)?bash\s*%; + + # Remove "simple" target names + s/^[\w%.-]+(?:\s+[\w%.-]+)*::?//; + s/^\t//; + s/(?<!\$)\$\((\w+)\)/\${$1}/g; + s/(\$){2}/$1/g; + s/^[\s\t]*[@-]{1,2}//; + } + + if ( + $cat_string ne "" + && (m/^\Q$cat_string\E$/ + || ($cat_indented && m/^\t*\Q$cat_string\E$/)) + ) { + $cat_string = ""; + next; + } + my $within_another_shell = 0; + if (m,(^|\s+)((/usr)?/bin/)?((b|d)?a|k|z|t?c)sh\s+-c\s*.+,) { + $within_another_shell = 1; + } + # if cat_string is set, we are in a HERE document and need not + # check for things + if ($cat_string eq "" and !$within_another_shell) { + my $found = 0; + my $match = ''; + my $explanation = ''; + my $line = $_; + + # Remove "" / '' as they clearly aren't quoted strings + # and not considering them makes the matching easier + $line =~ s/(^|[^\\])(\'\')+/$1/g; + $line =~ s/(^|[^\\])(\"\")+/$1/g; + + if ($quote_string ne "") { + my $otherquote = ($quote_string eq "\"" ? "\'" : "\""); + # Inside a quoted block + if ($line =~ /(?:^|^.*?[^\\])$quote_string(.*)$/) { + my $rest = $1; + my $templine = $line; + + # Remove quoted strings delimited with $otherquote + $templine + =~ s/(^|[^\\])$otherquote[^$quote_string]*?[^\\]$otherquote/$1/g; + # Remove quotes that are themselves quoted + # "a'b" + $templine + =~ s/(^|[^\\])$otherquote.*?$quote_string.*?[^\\]$otherquote/$1/g; + # "\"" + $templine + =~ s/(^|[^\\])$quote_string\\$quote_string$quote_string/$1/g; + + # After all that, were there still any quotes left? + my $count = () = $templine =~ /(^|[^\\])$quote_string/g; + next if $count == 0; + + $count = () = $rest =~ /(^|[^\\])$quote_string/g; + if ($count % 2 == 0) { + # Quoted block ends on this line + # Ignore everything before the closing quote + $line = $rest || ''; + $quote_string = ""; + } else { + next; + } + } else { + # Still inside the quoted block, skip this line + next; + } + } + + # Check even if we removed the end of a quoted block + # in the previous check, as a single line can end one + # block and begin another + if ($quote_string eq "") { + # Possible start of a quoted block + for my $quote ("\"", "\'") { + my $templine = $line; + my $otherquote = ($quote eq "\"" ? "\'" : "\""); + + # Remove balanced quotes and their content + while (1) { + my ($length_single, $length_double) = (0, 0); + + # Determine which one would match first: + if ($templine + =~ m/(^.+?(?:^|[^\\\"](?:\\\\)*)\')[^\']*\'/) { + $length_single = length($1); + } + if ($templine + =~ m/(^.*?(?:^|[^\\\'](?:\\\\)*)\")(?:\\.|[^\\\"])+\"/ + ) { + $length_double = length($1); + } + + # Now simplify accordingly (shorter is preferred): + if ( + $length_single != 0 + && ( $length_single < $length_double + || $length_double == 0) + ) { + $templine =~ s/(^|[^\\\"](?:\\\\)*)\'[^\']*\'/$1/; + } elsif ($length_double != 0) { + $templine + =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1/; + } else { + last; + } + } + + # Don't flag quotes that are themselves quoted + # "a'b" + $templine =~ s/$otherquote.*?$quote.*?$otherquote//g; + # "\"" + $templine =~ s/(^|[^\\])$quote\\$quote$quote/$1/g; + # \' or \" + $templine =~ s/\\[\'\"]//g; + my $count = () = $templine =~ /(^|(?!\\))$quote/g; + + # If there's an odd number of non-escaped + # quotes in the line it's almost certainly the + # start of a quoted block. + if ($count % 2 == 1) { + $quote_string = $quote; + $start_lines{'quote_string'} = $.; + $line =~ s/^(.*)$quote.*$/$1/; + last; + } + } + } + + # since this test is ugly, I have to do it by itself + # detect source (.) trying to pass args to the command it runs + # The first expression weeds out '. "foo bar"' + if ( not $found + and not +m/$LEADIN\.\s+(\"[^\"]+\"|\'[^\']+\'|\$\([^)]+\)+(?:\/[^\s;]+)?)\s*(\&|\||\d?>|<|;|\Z)/o + and m/$LEADIN(\.\s+[^\s;\`:]+\s+([^\s;]+))/o) { + if ($2 =~ /^(\&|\||\d?>|<)/) { + # everything is ok + ; + } else { + $found = 1; + $match = $1; + $explanation = "sourced script with arguments"; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + # Remove "quoted quotes". They're likely to be inside + # another pair of quotes; we're not interested in + # them for their own sake and removing them makes finding + # the limits of the outer pair far easier. + $line =~ s/(^|[^\\\'\"])\"\'\"/$1/g; + $line =~ s/(^|[^\\\'\"])\'\"\'/$1/g; + + foreach my $re (@singlequote_bashisms_keys) { + my $expl = $singlequote_bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + my $re = '(?<![\$\\\])\$\'[^\']+\''; + if ($line =~ m/(.*)($re)/o) { + my $count = () = $1 =~ /(^|[^\\])\'/g; + if ($count % 2 == 0) { + output_explanation($display_filename, $orig_line, + q<$'...' should be "$(printf '...')">); + } + } + + # $cat_line contains the version of the line we'll check + # for heredoc delimiters later. Initially, remove any + # spaces between << and the delimiter to make the following + # updates to $cat_line easier. However, don't remove the + # spaces if the delimiter starts with a -, as that changes + # how the delimiter is searched. + my $cat_line = $line; + $cat_line =~ s/(<\<-?)\s+(?!-)/$1/g; + + # Ignore anything inside single quotes; it could be an + # argument to grep or the like. + $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + + # As above, with the exception that we don't remove the string + # if the quote is immediately preceded by a < or a -, so we + # can match "foo <<-?'xyz'" as a heredoc later + # The check is a little more greedy than we'd like, but the + # heredoc test itself will weed out any false positives + $cat_line =~ s/(^|[^<\\\"-](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + + $re = '(?<![\$\\\])\$\"[^\"]+\"'; + if ($line =~ m/(.*)($re)/o) { + my $count = () = $1 =~ /(^|[^\\])\"/g; + if ($count % 2 == 0) { + output_explanation($display_filename, $orig_line, + q<$"foo" should be eval_gettext "foo">); + } + } + + foreach my $re (@string_bashisms_keys) { + my $expl = $string_bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + # We've checked for all the things we still want to notice in + # double-quoted strings, so now remove those strings as well. + $line =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + foreach my $re (@bashisms_keys) { + my $expl = $bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + # This check requires the value to be compared, which could + # be done in the regex itself but requires "use re 'eval'". + # So it's better done in its own + if ($line =~ m/$LEADIN((?:exit|return)\s+(\d{3,}))/o && $2 > 255) { + $explanation = 'exit|return status code greater than 255'; + output_explanation($display_filename, $orig_line, + $explanation); + } + + # Only look for the beginning of a heredoc here, after we've + # stripped out quoted material, to avoid false positives. + if ($cat_line + =~ m/(?:^|[^<])\<\<(\-?)\s*(?:(?!<|'|")((?:[^\s;>|]+(?:(?<=\\)[\s;>|])?)+)|[\'\"](.*?)[\'\"])/ + ) { + $cat_indented = ($1 && $1 eq '-') ? 1 : 0; + my $quoted = defined($3); + $cat_string = $quoted ? $3 : $2; + unless ($quoted) { + # Now strip backslashes. Keep the position of the + # last match in a variable, as s/// resets it back + # to undef, but we don't want that. + my $pos = 0; + pos($cat_string) = $pos; + while ($cat_string =~ s/\G(.*?)\\/$1/) { + # position += length of match + the character + # that followed the backslash: + $pos += length($1) + 1; + pos($cat_string) = $pos; + } + } + $start_lines{'cat_string'} = $.; + } + } + } + + warn +"error: $display_filename: Unterminated heredoc found, EOF reached. Wanted: <$cat_string>, opened in line $start_lines{'cat_string'}\n" + if ($cat_string ne ''); + warn +"error: $display_filename: Unterminated quoted string found, EOF reached. Wanted: <$quote_string>, opened in line $start_lines{'quote_string'}\n" + if ($quote_string ne ''); + warn "error: $display_filename: EOF reached while on line continuation.\n" + if ($buffered_line ne ''); + + close C; + + if ($mode && !$issues) { + warn "could not find any possible bashisms in bash script $filename\n"; + $status |= 4; + } +} + +exit $status; + +sub output_explanation { + my ($filename, $line, $explanation) = @_; + + if ($mode) { + # When examining a bash script, just flag that there are indeed + # bashisms present + $issues = 1; + } else { + warn "possible bashism in $filename line $. ($explanation):\n$line\n"; + if ($opt_early_fail) { + exit 1; + } + $status |= 1; + } +} + +# Returns non-zero if the given file is not actually a shell script, +# just looks like one. +sub script_is_evil_and_wrong { + my ($filename) = @_; + my $ret = -1; + # lintian's version of this function aborts if the file + # can't be opened, but we simply return as the next + # test in the calling code handles reporting the error + # itself + open(IN, '<', $filename) or return $ret; + my $i = 0; + my $var = "0"; + my $backgrounded = 0; + local $_; + while (<IN>) { + chomp; + next if /^#/o; + next if /^$/o; + last if (++$i > 55); + if ( + m~ + # the exec should either be "eval"ed or a new statement + (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*) + + # eat anything between the exec and $0 + exec\s*.+\s* + + # optionally quoted executable name (via $0) + .?\$$var.?\s* + + # optional "end of options" indicator + (--\s*)? + + # Match expressions of the form '${1+$@}', '${1:+"$@"', + # '"${1+$@', "$@", etc where the quotes (before the dollar + # sign(s)) are optional and the second (or only if the $1 + # clause is omitted) parameter may be $@ or $*. + # + # Finally the whole subexpression may be omitted for scripts + # which do not pass on their parameters (i.e. after re-execing + # they take their parameters (and potentially data) from stdin + .?(\$\{1:?\+.?)?(\$(\@|\*))?~x + ) { + $ret = $. - 1; + last; + } elsif (/^\s*(\w+)=\$0;/) { + $var = $1; + } elsif ( + m~ + # Match scripts which use "foo $0 $@ &\nexec true\n" + # Program name + \S+\s+ + + # As above + .?\$$var.?\s* + (--\s*)? + .?(\$\{1:?\+.?)?(\$(\@|\*))?.?\s*\&~x + ) { + + $backgrounded = 1; + } elsif ( + $backgrounded + and m~ + # the exec should either be "eval"ed or a new statement + (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*) + exec\s+true(\s|\Z)~x + ) { + + $ret = $. - 1; + last; + } elsif (m~\@DPATCH\@~) { + $ret = $. - 1; + last; + } + + } + close IN; + return $ret; +} + +sub init_hashes { + + %bashisms = ( + qr'(?:^|\s+)function [^<>\(\)\[\]\{\};|\s]+(\s|\(|\Z)' => + q<'function' is useless>, + $LEADIN . qr'select\s+\w+' => q<'select' is not POSIX>, + qr'(test|-o|-a)\s*[^\s]+\s+==\s' => q<should be 'b = a'>, + qr'\[\s+[^\]]+\s+==\s' => q<should be 'b = a'>, + qr'\s\|\&' => q<pipelining is not POSIX>, + qr'[^\\\$]\{([^\s\\\}]*?,)+[^\\\}\s]*\}' => q<brace expansion>, + qr'\{\d+\.\.\d+(?:\.\.\d+)?\}' => + q<brace expansion, {a..b[..c]}should be $(seq a [c] b)>, + qr'(?i)\{[a-z]\.\.[a-z](?:\.\.\d+)?\}' => q<brace expansion>, + qr'(?:^|\s+)\w+\[\d+\]=' => q<bash arrays, H[0]>, + $LEADIN + . qr'read\s+(?:-[a-qs-zA-Z\d-]+)' => + q<read with option other than -r>, + $LEADIN + . qr'read\s*(?:-\w+\s*)*(?:\".*?\"|[\'].*?[\'])?\s*(?:;|$)' => + q<read without variable>, + $LEADIN . qr'echo\s+(-n\s+)?-n?en?\s' => q<echo -e>, + $LEADIN . qr'exec\s+-[acl]' => q<exec -c/-l/-a name>, + $LEADIN . qr'let\s' => q<let ...>, + qr'(?<![\$\(])\(\(.*\)\)' => q<'((' should be '$(('>, + qr'(?:^|\s+)(\[|test)\s+-a' => q<test with unary -a (should be -e)>, + qr'\&>' => q<should be \>word 2\>&1>, + qr'(<\&|>\&)\s*((-|\d+)[^\s;|)}`&\\\\]|[^-\d\s]+(?<!\$)(?!\d))' => + q<should be \>word 2\>&1>, + qr'\[\[(?!:)' => + q<alternative test command ([[ foo ]] should be [ foo ])>, + qr'/dev/(tcp|udp)' => q</dev/(tcp|udp)>, + $LEADIN . qr'builtin\s' => q<builtin>, + $LEADIN . qr'caller\s' => q<caller>, + $LEADIN . qr'compgen\s' => q<compgen>, + $LEADIN . qr'complete\s' => q<complete>, + $LEADIN . qr'declare\s' => q<declare>, + $LEADIN . qr'dirs(\s|\Z)' => q<dirs>, + $LEADIN . qr'disown\s' => q<disown>, + $LEADIN . qr'enable\s' => q<enable>, + $LEADIN . qr'mapfile\s' => q<mapfile>, + $LEADIN . qr'readarray\s' => q<readarray>, + $LEADIN . qr'shopt(\s|\Z)' => q<shopt>, + $LEADIN . qr'suspend\s' => q<suspend>, + $LEADIN . qr'time\s' => q<time>, + $LEADIN . qr'type\s' => q<type>, + $LEADIN . qr'typeset\s' => q<typeset>, + $LEADIN . qr'ulimit(\s|\Z)' => q<ulimit>, + $LEADIN . qr'set\s+-[BHT]+' => q<set -[BHT]>, + $LEADIN . qr'alias\s+-p' => q<alias -p>, + $LEADIN . qr'unalias\s+-a' => q<unalias -a>, + $LEADIN . qr'local\s+-[a-zA-Z]+' => q<local -opt>, + # function '=' is special-cased due to bash arrays (think of "foo=()") + qr'(?:^|\s)\s*=\s*\(\s*\)\s*([\{|\(]|\Z)' => + q<function names should only contain [a-z0-9_]>, +qr'(?:^|\s)(?<func>function\s)?\s*(?:[^<>\(\)\[\]\{\};|\s]*[^<>\(\)\[\]\{\};|\s\w][^<>\(\)\[\]\{\};|\s]*)(?(<func>)(?=)|(?<!=))\s*(?(<func>)(?:\(\s*\))?|\(\s*\))\s*([\{|\(]|\Z)' + => q<function names should only contain [a-z0-9_]>, + $LEADIN . qr'(push|pop)d(\s|\Z)' => q<(push|pop)d>, + $LEADIN . qr'export\s+-[^p]' => q<export only takes -p as an option>, + qr'(?:^|\s+)[<>]\(.*?\)' => q<\<() process substitution>, + $LEADIN . qr'readonly\s+-[af]' => q<readonly -[af]>, + $LEADIN . qr'(sh|\$\{?SHELL\}?) -[rD]' => q<sh -[rD]>, + $LEADIN . qr'(sh|\$\{?SHELL\}?) --\w+' => q<sh --long-option>, + $LEADIN . qr'(sh|\$\{?SHELL\}?) [-+]O' => q<sh [-+]O>, + qr'\[\^[^]]+\]' => q<[^] should be [!]>, + $LEADIN + . qr'printf\s+-v' => + q<'printf -v var ...' should be var='$(printf ...)'>, + $LEADIN . qr'coproc\s' => q<coproc>, + qr';;?&' => q<;;& and ;& special case operators>, + $LEADIN . qr'jobs\s' => q<jobs>, + # $LEADIN . qr'jobs\s+-[^lp]\s' => q<'jobs' with option other than -l or -p>, + $LEADIN + . qr'command\s+(?:-[pvV]+\s+)*-(?:[pvV])*[^pvV\s]' => + q<'command' with option other than -p, -v or -V>, + $LEADIN + . qr'setvar\s' => + q<setvar 'foo' 'bar' should be eval 'foo="'"$bar"'"'>, + $LEADIN + . qr'trap\s+["\']?.*["\']?\s+.*(?:ERR|DEBUG|RETURN)' => + q<trap with ERR|DEBUG|RETURN>, + $LEADIN + . qr'(?:exit|return)\s+-\d' => + q<exit|return with negative status code>, + $LEADIN + . qr'(?:exit|return)\s+--' => + q<'exit --' should be 'exit' (idem for return)>, + $LEADIN . qr'hash(\s|\Z)' => q<hash>, + qr'(?:[:=\s])~(?:[+-]|[+-]?\d+)(?:[/\s]|\Z)' => + q<non-standard tilde expansion>, + ); + + %string_bashisms = ( + qr'\$\[[^][]+\]' => q<'$[' should be '$(('>, + qr'\$\{(?:\w+|@|\*)\:(?:\d+|\$\{?\w+\}?)+(?::(?:\d+|\$\{?\w+\}?)+)?\}' + => q<${foo:3[:1]}>, + qr'\$\{!\w+[\@*]\}' => q<${!prefix[*|@]>, + qr'\$\{!\w+\}' => q<${!name}>, + qr'\$\{(?:\w+|@|\*)([,^]{1,2}.*?)\}' => + q<${parm,[,][pat]} or ${parm^[^][pat]}>, + qr'\$\{[@*]([#%]{1,2}.*?)\}' => q<${[@|*]#[#]pat} or ${[@|*]%[%]pat}>, + qr'\$\{#[@*]\}' => q<${#@} or ${#*}>, + qr'\$\{(?:\w+|@|\*)(/.+?){1,2}\}' => q<${parm/?/pat[/str]}>, + qr'\$\{\#?\w+\[.+\](?:[/,:#%^].+?)?\}' => + q<bash arrays, ${name[0|*|@]}>, + qr'\$\{?RANDOM\}?\b' => q<$RANDOM>, + qr'\$\{?(OS|MACH)TYPE\}?\b' => q<$(OS|MACH)TYPE>, + qr'\$\{?HOST(TYPE|NAME)\}?\b' => q<$HOST(TYPE|NAME)>, + qr'\$\{?DIRSTACK\}?\b' => q<$DIRSTACK>, + qr'\$\{?EUID\}?\b' => q<$EUID should be "$(id -u)">, + qr'\$\{?UID\}?\b' => q<$UID should be "$(id -ru)">, + qr'\$\{?SECONDS\}?\b' => q<$SECONDS>, + qr'\$\{?BASH_[A-Z]+\}?\b' => q<$BASH_SOMETHING>, + qr'\$\{?SHELLOPTS\}?\b' => q<$SHELLOPTS>, + qr'\$\{?PIPESTATUS\}?\b' => q<$PIPESTATUS>, + qr'\$\{?SHLVL\}?\b' => q<$SHLVL>, + qr'\$\{?FUNCNAME\}?\b' => q<$FUNCNAME>, + qr'\$\{?TMOUT\}?\b' => q<$TMOUT>, + qr'(?:^|\s+)TMOUT=' => q<TMOUT=>, + qr'\$\{?TIMEFORMAT\}?\b' => q<$TIMEFORMAT>, + qr'(?:^|\s+)TIMEFORMAT=' => q<TIMEFORMAT=>, + qr'(?<![$\\])\$\{?_\}?\b' => q<$_>, + qr'(?:^|\s+)GLOBIGNORE=' => q<GLOBIGNORE=>, + qr'<<<' => q<\<\<\< here string>, + $LEADIN + . qr'echo\s+(?:-[^e\s]+\s+)?\"[^\"]*(\\[abcEfnrtv0])+.*?[\"]' => + q<unsafe echo with backslash>, + qr'\$\(\([\s\w$*/+-]*\w\+\+.*?\)\)' => + q<'$((n++))' should be '$n; $((n=n+1))'>, + qr'\$\(\([\s\w$*/+-]*\+\+\w.*?\)\)' => + q<'$((++n))' should be '$((n=n+1))'>, + qr'\$\(\([\s\w$*/+-]*\w\-\-.*?\)\)' => + q<'$((n--))' should be '$n; $((n=n-1))'>, + qr'\$\(\([\s\w$*/+-]*\-\-\w.*?\)\)' => + q<'$((--n))' should be '$((n=n-1))'>, + qr'\$\(\([\s\w$*/+-]*\*\*.*?\)\)' => q<exponentiation is not POSIX>, + $LEADIN . qr'printf\s["\'][^"\']*?%q.+?["\']' => q<printf %q>, + ); + + %singlequote_bashisms = ( + $LEADIN + . qr'echo\s+(?:-[^e\s]+\s+)?\'[^\']*(\\[abcEfnrtv0])+.*?[\']' => + q<unsafe echo with backslash>, + $LEADIN + . qr'source\s+[\"\']?(?:\.\/|\/|\$|[\w~.-])\S*' => + q<should be '.', not 'source'>, + ); + + if ($opt_echo) { + $bashisms{ $LEADIN . qr'echo\s+-[A-Za-z]*n' } = q<echo -n>; + } + if ($opt_posix) { + $bashisms{ $LEADIN . qr'local\s+\w+(\s+\W|\s*[;&|)]|$)' } + = q<local foo>; + $bashisms{ $LEADIN . qr'local\s+\w+=' } = q<local foo=bar>; + $bashisms{ $LEADIN . qr'local\s+\w+\s+\w+' } = q<local x y>; + $bashisms{ $LEADIN . qr'((?:test|\[)\s+.+\s-[ao])\s' } = q<test -a/-o>; + $bashisms{ $LEADIN . qr'kill\s+-[^sl]\w*' } = q<kill -[0-9] or -[A-Z]>; + $bashisms{ $LEADIN . qr'trap\s+["\']?.*["\']?\s+.*[1-9]' } + = q<trap with signal numbers>; + } + + if ($makefile) { + $string_bashisms{qr'(\$\(|\`)\s*\<\s*([^\s\)]{2,}|[^DF])\s*(\)|\`)'} + = q<'$(\< foo)' should be '$(cat foo)'>; + } else { + $bashisms{ $LEADIN . qr'\w+\+=' } = q<should be VAR="${VAR}foo">; + $string_bashisms{qr'(\$\(|\`)\s*\<\s*\S+\s*(\)|\`)'} + = q<'$(\< foo)' should be '$(cat foo)'>; + } + + if ($opt_extra) { + $string_bashisms{qr'\$\{?BASH\}?\b'} = q<$BASH>; + $string_bashisms{qr'(?:^|\s+)RANDOM='} = q<RANDOM=>; + $string_bashisms{qr'(?:^|\s+)(OS|MACH)TYPE='} = q<(OS|MACH)TYPE=>; + $string_bashisms{qr'(?:^|\s+)HOST(TYPE|NAME)='} = q<HOST(TYPE|NAME)=>; + $string_bashisms{qr'(?:^|\s+)DIRSTACK='} = q<DIRSTACK=>; + $string_bashisms{qr'(?:^|\s+)EUID='} = q<EUID=>; + $string_bashisms{qr'(?:^|\s+)UID='} = q<UID=>; + $string_bashisms{qr'(?:^|\s+)BASH(_[A-Z]+)?='} = q<BASH(_SOMETHING)=>; + $string_bashisms{qr'(?:^|\s+)SHELLOPTS='} = q<SHELLOPTS=>; + $string_bashisms{qr'\$\{?POSIXLY_CORRECT\}?\b'} = q<$POSIXLY_CORRECT>; + } +} diff --git a/scripts/cowpoke.1 b/scripts/cowpoke.1 new file mode 100644 index 0000000..7d5177b --- /dev/null +++ b/scripts/cowpoke.1 @@ -0,0 +1,388 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH COWPOKE 1 "April 28, 2008" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +cowpoke \- Build a Debian source package in a remote cowbuilder instance +.SH SYNOPSIS +.B cowpoke +.RI [ options ] " packagename.dsc" + +.SH DESCRIPTION +Uploads a Debian source package to a \fBcowbuilder\fR host and builds it, +optionally also signing and uploading the result to an incoming queue. + + +.SH OPTIONS +The following options are available: + +.TP +.BI \-\-arch= architecture +Specify the Debian architecture(s) to build for. A space separated list of +architectures may be used to build for all of them in a single pass. Valid +arch names are those returned by \fBdpkg-architecture\fP(1) for +\fBDEB_BUILD_ARCH\fP. + +.TP +.BI \-\-dist= distribution +Specify the Debian distribution(s) to build for. A space separated list of +distributions may be used to build for all of them in a single pass. Either +codenames (such as \fBsid\fP, or \fBsqueeze\fP) or distribution names (such as +\fBunstable\fP, or \fBexperimental\fP) may be used, but you should usually stick +to using one or the other consistently as this name may be used in file paths +and to locate old packages for comparison reporting. + +It is now also possible to use locally defined names with this option, when +used in conjunction with the \fBBASE_DIST\fP option in a configuration file. +This permits the maintenance and use of specially configured build chroots, +which can source package dependencies from the backports archives or a local +repository, or have other unusual configuration options set, without polluting +the chroots you use for clean package builds intended for upload to the main +repositories. See the description of \fBBASE_DIST\fP below. + +.TP +.BI \-\-buildd= host +Specify the remote host to build on. + +.TP +.BI \-\-buildd\-user= name +Specify the remote user to build as. + +.TP +.B \-\-create +Create the remote \fBcowbuilder\fR root if it does not already exist. If this option +is not passed it is an error for the specified \fB\-\-dist\fP or \fB\-\-arch\fP +to not have an existing \fBcowbuilder\fR root in the expected location. + +The \fB\-\-buildd\-user\fP must have permission to create the \fBRESULT_DIR\fP +on the build host, or an admin with the necessary permission must first create +it and give that user (or some group they are in) write access to it, for this +option to succeed. + +.TP +.BR \-\-return= [ \fIpath ] +Copy results of the build to \fIpath\fP. If \fIpath\fP is not specified, then return +them to the current directory. The given \fIpath\fP must exist, it will not be created. + +.TP +.B \-\-no\-return +Do not copy results of the build to \fBRETURN_DIR\fP (overriding a path set for +it in the configuration files). + +.TP +.BI \-\-dpkg\-opts= "'opt1 opt2 ...'" +Specify additional options to be passed to \fBdpkg-buildpackage\fP(1). Multiple +options are delimited with spaces. This will override any options specified in +\fBDEBBUILDOPTS\fP in the build host's \fIpbuilderrc\fP. + +.TP +.BI \-\-create\-opts= "'cowbuilder option'" +Specify additional arguments to be passed verbatim to \fBcowbuilder\fR when a +chroot is first created (using the \fB\-\-create\fP option above). If multiple +arguments need to be passed, this option should be specified separately for +each of them. + +E.g., \fB\-\-create\-opts "\-\-othermirror" \-\-create\-opts "deb http:// ..."\fP + +This option will override any \fBCREATE_OPTS\fP specified for a chroot in the +cowpoke configuration files. + +.TP +.BI \-\-update\-opts= "'cowbuilder option'" +Specify additional arguments to be passed verbatim to \fBcowbuilder\fR if the +base of the chroot is updated. If multiple arguments need to be passed, this +option should be specified separately for each of them. + +This option will override any \fBUPDATE_OPTS\fP specified for a chroot in the +cowpoke configuration files. + +.TP +.BI \-\-build\-opts= "'cowbuilder option'" +Specify additional arguments to be passed verbatim to \fBcowbuilder\fR when +a package build is performed. If multiple arguments need to be passed, this +option should be specified separately for each of them. + +This option will override any \fBBUILD_OPTS\fP specified for a chroot in the +cowpoke configuration files. + +.TP +.BI \-\-sign= keyid +Specify the key to sign packages with. This will override any \fBSIGN_KEYID\fP +specified for a chroot in the cowpoke configuration files. + +.TP +.BI \-\-upload= queue +Specify the dput queue to upload signed packages to. This will override any +\fBUPLOAD_QUEUE\fP specified for a chroot in the cowpoke configuration files. + +.TP +.B \-\-help +Display a brief summary of the available options and current configuration. + +.TP +.B \-\-version +Display the current version information. + + +.SH CONFIGURATION OPTIONS +When \fBcowpoke\fP is run the following configuration options are read from +global, per\-user, and per\-project configuration files if present. File paths +may be absolute or relative, the latter being relative to the \fBBUILDD_USER\fR's +home directory. Since the paths are typically quoted when used, tilde expansion +will \fBnot\fP be performed on them. + +.SS Global defaults +These apply to every \fIarch\fP and \fIdist\fP in a single cowpoke invocation. + +.TP +.B BUILDD_HOST +The network address or fqdn of the build machine where \fBcowbuilder\fR is configured. +This may be overridden by the \fB\-\-buildd\fP command line option. +.TP +.B BUILDD_USER +The unprivileged user name for operations on the build machine. This defaults +to the local name of the user executing \fBcowpoke\fP (or to a username that is +specified in your SSH configuration for \fBBUILDD_HOST\fR), and may be overridden by the +\fB\-\-buildd\-user\fP command line option. +.TP +.B BUILDD_ARCH +The Debian architecture(s) to build for. This must match the \fBDEB_BUILD_ARCH\fP +of the build chroot being used. It defaults to the local machine architecture where +\fBcowpoke\fP is executed, and may be overridden by the \fB\-\-arch\fP command line +option. A (quoted) space separated list of architectures may be used here to build +for all of them in a single pass. +.TP +.B BUILDD_DIST +The Debian distribution(s) to build for. A (quoted) space separated list of +distributions may be used to build for all of them in a single pass. This may +be overridden by the \fB\-\-dist\fP command line option. + +.TP +.B INCOMING_DIR +The directory path on the build machine where the source package will initially +be placed. This must be writable by the \fBBUILDD_USER\fP. +.TP +.B PBUILDER_BASE +The filesystem root for all pbuilder CoW and result files. \fIArch\fP and \fIdist\fP +specific subdirectories will normally be created under this. The apt cache +and temporary build directory will also be located under this path. + +.TP +.B SIGN_KEYID +If this option is set, it is expected to contain the gpg key ID to pass to +\fBdebsign\fP(1) if the packages are to be remotely signed. You will be prompted +to confirm whether you wish to sign the packages after all builds are complete. +If this option is unset or an empty string, no attempt to sign packages will be +made. It may be overridden on an \fIarch\fP and \fIdist\fP specific basis using +the +.IB arch _ dist _SIGN_KEYID +option described below, or per-invocation with the \fB\-\-sign\fP command line +option. + +.TP +.B UPLOAD_QUEUE +If this option is set, it is expected to contain a 'host' specification for +\fBdput\fP(1) which will be used to upload them after they are signed. You will +be prompted to confirm whether you wish to upload the packages after they are +signed. If this option is unset or an empty string, no attempt to upload packages +will be made. If \fBSIGN_KEYID\fP is not set, this option will be ignored entirely. +It may be overridden on an \fIarch\fP and \fIdist\fP specific basis using the +.IB arch _ dist _UPLOAD_QUEUE +option described below, or per-invocation with the \fB\-\-upload\fP command line +option. + + +.TP +.B BUILDD_ROOTCMD +The command to use to gain root privileges on the remote build machine. If +unset the default is \fBsudo\fP(8). This is only required to invoke \fBcowbuilder\fR +and allow it to enter its chroot, so you may restrict this user to only being +able to run that command with escalated privileges. Something like this in +sudoers will enable invoking \fBcowbuilder\fR without an additional password entry +required: +.TP +.B " " +.RS 1.5i +youruser ALL = NOPASSWD: /usr/sbin/cowbuilder +.RE +.TP +.B " " +Alternatively you could use SSH with a forwarded key, or whatever other +mechanism suits your local access policy. Using \fBsu \-c\fR isn't really +suitable here due to its quoting requirements being somewhat different to +the rest. + +.TP +.B DEBOOTSTRAP +The utility to use when creating a new build root. Alternatives are +.BR debootstrap " or " cdebootstrap . + +.TP +.B RETURN_DIR +If set, package files resulting from the build will be copied to the path +(local or remote) that this is set to, after the build completes. The path +must exist, it will not be created. This option is unset by default and can +be overridden with \fB\-\-return\fR or \fB\-\-no-return\fR. + + +.SS Arch and dist specific options +These are variables of the form: $arch_$dist\fB_VAR\fR which apply only for a +particular target arch/dist build. + +.TP +.IB arch _ dist _RESULT_DIR +The directory path on the build machine where the resulting packages (source and +binary) will be found, and where older versions of the package that were built +previously may be found. If any such older packages exist, \fBdebdiff\fP will +be used to compare the new package with the previous version after the build is +complete, and the result will be included in the build log. Files in it must be +readable by the \fBBUILDD_USER\fP for sanity checking with \fBlintian\fP(1) and +\fBdebdiff\fP(1), and for upload with \fBdput\fP(1). If this option is not +specified for some arch and dist combination then it will default to +.I $PBUILDER_BASE/$arch/$dist/result + +.TP +.IB arch _ dist _BASE_PATH +The directory where the CoW master files are to be found (or created if the +\fB\-\-create\fP command line option was passed). If this option is not specified +for some arch or dist then it will default to +.I $PBUILDER_BASE/$arch/$dist/base.cow + +.TP +.IB arch _ dist _BASE_DIST +The code name to pass as the \fB\-\-distribution\fP option for cowbuilder instead +of \fIdist\fP. This is necessary when \fIdist\fP is a locally significant name +assigned to some specially configured build chroot, such as 'wheezy_backports', +and not the formal suite name of a distro release known to debootstrap. This +option cannot be overridden on the command line, since it would rarely, if ever, +make any sense to change it for individual invocations of \fBcowpoke\fP. If this +option is not specified for an arch and dist combination then it will default to +.IR dist . + +.TP +.IB arch _ dist _CREATE_OPTS +A bash array containing additional options to pass verbatim to \fBcowbuilder\fP +when this chroot is created for the first time (using the \fB\-\-create\fP option). +This is useful when options like \fB\-\-othermirror\fP are wanted to create +specialised chroot configurations such as 'wheezy_backports'. By default this +is unset. All values set in it will be overridden if the \fB\-\-create\-opts\fP +option is passed on the command line. + +Each element in this array corresponds to a single argument (in the ARGV sense) +that will be passed to cowbuilder. This ensures that arguments which may contain +whitespace or have strange quoting requirements or other special characters will +not be mangled before they get to cowbuilder. + +Bash arrays are initialised using the following form: + + OPTS=( "arg1" "arg 2" "\-\-option" "value" "\-\-opt=val" "etc. etc." ) + +.TP +.IB arch _ dist _UPDATE_OPTS +A bash array containing additional options to pass verbatim to \fBcowbuilder\fP +each time the base of this chroot is updated. It behaves similarly to the +\fBCREATE_OPTS\fP option above, except for acting when the chroot is updated. + +.TP +.IB arch _ dist _BUILD_OPTS +A bash array containing additional options to pass verbatim to \fBcowbuilder\fP +each time a package build is performed in this chroot. This is useful when you +want to use some option like \fB\-\-twice\fP which cowpoke does not directly +need to care about. It otherwise behaves similarly to \fBUPDATE_OPTS\fP above +except that it acts during the build phase of \fBcowbuilder\fP. + +.TP +.IB arch _ dist _SIGN_KEYID +An optional arch and dist specific override for the global \fBSIGN_KEYID\fP +option. + +.TP +.IB arch _ dist _UPLOAD_QUEUE +An optional arch and dist specific override for the global \fBUPLOAD_QUEUE\fP +option. + + +.SH CONFIGURATION FILES +.TP +.I /etc/cowpoke.conf +Global configuration options. Will override hardcoded defaults. +.TP +.I ~/.cowpoke +Per\-user configuration options. Will override any global configuration. +.TP +.I .cowpoke +Per\-project configuration options. Will override any per-user or global +configuration if \fBcowpoke\fP is called from the directory where they exist. + +If the environment variable \fBCOWPOKE_CONF\fP is set, it specifies an additional +configuration file which will override all of those above. Options specified +explicitly on the command line override all configuration files. + + +.SH COWBUILDER CONFIGURATION +There is nothing particularly special required to configure a \fBcowbuilder\fR instance +for use with \fBcowpoke\fP. Simply create them in the flavour you require with +`\fBcowbuilder \-\-create\fP` according to the \fBcowbuilder\fR documentation, then +configure \fBcowpoke\fP with the user, arch, and path information required to +access it, on the machines you wish to invoke it from (or alternatively configure +\fBcowpoke\fP with the path, arch and distribution information and pass the +\fB\-\-create\fP option to it on the first invocation). The build host running +\fBcowbuilder\fR does not require \fBcowpoke\fP installed locally. + +The build machine should have the \fBlintian\fP and \fBdevscripts\fR packages +installed for post-build sanity checking. Upon completion, the build log and +the results of automated checks will be recorded in the \fBINCOMING_DIR\fP. +If you wish to upload signed packages the build machine will also need +\fBdput\fP(1) installed and configured to use the '\fIhost\fP' alias specified +by \fBUPLOAD_QUEUE\fP. If \fBrsync\fP(1) is available on both the local and +build machine, then it will be used to transfer the source package (this may +save on some transfers of the \fIorig.tar.*\fP when building subsequent Debian +revisions). + +The user executing \fBcowpoke\fP must have SSH access to the build machine as +the \fBBUILDD_USER\fP. That user must be able to invoke \fBcowbuilder\fR as root by +using the \fBBUILDD_ROOTCMD\fP. Signing keys are not required to be installed +on the build machine (and will be ignored there if they are). If the package +is signed, keys will be expected on the machine that executes \fBcowpoke\fP. + +When \fBcowpoke\fP is invoked, it will first attempt to update the \fBcowbuilder\fR +image if that has not already been done on the same day. This is checked by +the presence or absence of a \fIcowbuilder-$arch-$dist-update-log-$date\fP file +in the \fBINCOMING_DIR\fP. You may move, remove, or touch this file if you wish +the image to be updated more or less often than that. Its contents log the +output of \fBcowbuilder\fR during the update (or creation) of the build root. + + +.SH NOTES +Since \fBcowbuilder\fP creates a chroot, and to do that you need root, \fBcowpoke\fP +also requires some degree of root access. So all the horrible things that can +go wrong with that may well one day rain down upon you. \fBcowbuilder\fR has been +known to accidentally wipe out bind-mounted filesystems outside the chroot, and +worse than that can easily happen. So be careful, keep good backups of things +you don't want to lose on your build machine, and use \fBcowpoke\fP to keep all +that on a machine that isn't your bleeding edge dev box with your last few hours +of uncommitted work. + +.SH SEE ALSO +.BR cowbuilder (1), +.BR pbuilder (1), +.BR ssh-agent (1), +.BR sudoers (5) + +.SH AUTHOR +.B cowpoke +was written by Ron <\fIron@debian.org\fP>. + diff --git a/scripts/cowpoke.sh b/scripts/cowpoke.sh new file mode 100755 index 0000000..9531658 --- /dev/null +++ b/scripts/cowpoke.sh @@ -0,0 +1,547 @@ +#!/bin/bash +# Simple shell script for driving a remote cowbuilder via ssh +# +# Copyright(C) 2007, 2008, 2009, 2011, 2012, 2014, Ron <ron@debian.org> +# This script is distributed according to the terms of the GNU GPL. + +set -e + +#BUILDD_HOST= +#BUILDD_USER= +BUILDD_ARCH="$(dpkg-architecture -qDEB_BUILD_ARCH 2>/dev/null)" + +# The 'default' dist is whatever cowbuilder is locally configured for +BUILDD_DIST="default" + +INCOMING_DIR="cowbuilder-incoming" +PBUILDER_BASE="/var/cache/pbuilder" + +#SIGN_KEYID= +#UPLOAD_QUEUE="ftp-master" +BUILDD_ROOTCMD="sudo" + +REMOTE_SCRIPT="cowssh_it" +DEBOOTSTRAP="cdebootstrap" + +for f in /etc/cowpoke.conf ~/.cowpoke .cowpoke "$COWPOKE_CONF"; do [ -r "$f" ] && . "$f"; done + + +get_archdist_vars() +{ + _ARCHDIST_OPTIONS="RESULT_DIR BASE_PATH BASE_DIST CREATE_OPTS UPDATE_OPTS BUILD_OPTS SIGN_KEYID UPLOAD_QUEUE" + _RESULT_DIR="result" + _BASE_PATH="base.cow" + + for arch in $BUILDD_ARCH; do + for dist in $BUILDD_DIST; do + for var in $_ARCHDIST_OPTIONS; do + eval "val=( \"\${${arch}_${dist}_${var}[@]}\" )" + + if [ "$1" = "display" ]; then + case $var in + RESULT_DIR | BASE_PATH ) + [ ${#val[@]} -gt 0 ] || eval "val=\"$PBUILDER_BASE/$arch/$dist/\$_$var\"" + echo " ${arch}_${dist}_${var} = $val" + ;; + + *_OPTS ) + # Don't display these if they are overridden on the command line. + eval "override=( \"\${OVERRIDE_${var}[@]}\" )" + [ ${#override[@]} -gt 0 ] || [ ${#val[@]} -eq 0 ] || + echo " ${arch}_${dist}_${var} =$(printf " '%s'" "${val[@]}")" + ;; + + * ) + [ ${#val[@]} -eq 0 ] || echo " ${arch}_${dist}_${var} = $val" + ;; + esac + else + case $var in + RESULT_DIR | BASE_PATH ) + # These are always a single value, and must always be set, + # either by the user or to their default value. + [ ${#val[@]} -gt 0 ] || eval "val=\"$PBUILDER_BASE/$arch/$dist/\$_$var\"" + echo "${arch}_${dist}_${var}='$val'" + ;; + + *_OPTS ) + # These may have zero, one, or many values which we must not word-split. + # They can safely remain unset if there are no values. + # + # We don't need to worry about the command line overrides here, + # they will be taken care of in the remote script. + [ ${#val[@]} -eq 0 ] || + echo "${arch}_${dist}_${var}=($(printf " %q" "${val[@]}") )" + ;; + + SIGN_KEYID | UPLOAD_QUEUE ) + # We don't need these in the remote script + ;; + + * ) + # These may have zero or one value. + # They can safely remain unset if there are no values. + [ ${#val[@]} -eq 0 ] || echo "${arch}_${dist}_${var}='$val'" + ;; + esac + fi + done + done + done +} + +display_override_vars() +{ + _OVERRIDE_OPTIONS="CREATE_OPTS UPDATE_OPTS BUILD_OPTS SIGN_KEYID UPLOAD_QUEUE" + + for var in $_OVERRIDE_OPTIONS; do + eval "override=( \"\${OVERRIDE_${var}[@]}\" )" + [ ${#override[@]} -eq 0 ] || echo " override: $var =$(printf " '%s'" "${override[@]}")" + done +} + + +PROGNAME="$(basename $0)" +version () +{ + echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is Copyright 2007-2014, Ron <ron@debian.org>. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License." + exit 0 +} + +usage() +{ + cat 1>&2 <<EOF + +cowpoke [options] package.dsc + + Uploads a Debian source package to a cowbuilder host and builds it, + optionally also signing and uploading the result to an incoming queue. + The following options are supported: + + --arch="arch" Specify the Debian architecture(s) to build for. + --dist="dist" Specify the Debian distribution(s) to build for. + --buildd="host" Specify the remote host to build on. + --buildd-user="name" Specify the remote user to build as. + --create Create the remote cowbuilder root if necessary. + --return[="path"] Copy results of the build to 'path'. If path is + not specified, return them to the current directory. + --no-return Do not copy results of the build to RETURN_DIR + (overriding a path set for it in the config files). + --sign="keyid" Specify the key to sign packages with. + --upload="queue" Specify the dput queue to upload signed packages to. + + The current default configuration is: + + BUILDD_HOST = $BUILDD_HOST + BUILDD_USER = $BUILDD_USER + BUILDD_ARCH = $BUILDD_ARCH + BUILDD_DIST = $BUILDD_DIST + RETURN_DIR = $RETURN_DIR + SIGN_KEYID = $SIGN_KEYID + UPLOAD_QUEUE = $UPLOAD_QUEUE + + The expected remote paths are: + + INCOMING_DIR = $INCOMING_DIR + PBUILDER_BASE = ${PBUILDER_BASE:-/} + +$(get_archdist_vars display) +$(display_override_vars) + + The cowbuilder image must have already been created on the build host + and the expected remote paths must already exist if the --create option + is not passed. You must have ssh access to the build host as BUILDD_USER + if that is set, else as the user executing cowpoke or a user specified + in your ssh config for '$BUILDD_HOST'. + That user must be able to execute cowbuilder as root using '$BUILDD_ROOTCMD'. + +EOF + + exit $1 +} + + +for arg; do + case "$arg" in + --arch=*) + BUILDD_ARCH="${arg#*=}" + ;; + + --dist=*) + BUILDD_DIST="${arg#*=}" + ;; + + --buildd=*) + BUILDD_HOST="${arg#*=}" + ;; + + --buildd-user=*) + BUILDD_USER="${arg#*=}" + ;; + + --create) + CREATE_COW="yes" + ;; + + --return=*) + RETURN_DIR="${arg#*=}" + ;; + + --return) + RETURN_DIR=. + ;; + + --no-return) + RETURN_DIR= + ;; + + --dpkg-opts=*) + # This one is a bit tricky, given the combination of the calling convention here, + # the calling convention for cowbuilder, and the behaviour of things that might + # pass this option to us. Some things, like when we are called from the gitpkg + # hook using options from git-config, will preserve any quoting that was used in + # the .gitconfig file, which is natural for anyone to want to use in a construct + # like: options = --dpkg-opts='-uc -us -j6'. People are going to cringe if we + # tell them they must not use quotes there no matter how much it may 'make sense' + # if you know too much about the internals. And it will only get worse when we + # then tell them they must quote it like that if they type it directly in their + # shell ... + # + # So we do the only thing that seems sensible, and try to Deal With It here. + # If the outermost characters are paired quotes, we manually strip them off. + # We don't want to let the shell do quote removal, since that might change a + # part of this which we don't want modified. + # We collect however many sets of those we are passed in an array, which we'll + # then combine back into a single argument at the final point of use. + # + # Which _should_ DTRT for anyone who isn't trying to blow this up deliberately + # and maybe will still do it for them too in spite of their efforts. But unless + # someone finds a sensible case this fails on, I'm not going to cry over people + # who want to stuff up their own system with input they created themselves. + val=${arg#*=} + [[ $val == \'*\' || $val == \"*\" ]] && val=${val:1:-1} + DEBBUILDOPTS+=( "$val" ) + ;; + + --create-opts=*) + OVERRIDE_CREATE_OPTS+=( "${arg#*=}" ) + ;; + + --update-opts=*) + OVERRIDE_UPDATE_OPTS+=( "${arg#*=}" ) + ;; + + --build-opts=*) + OVERRIDE_BUILD_OPTS+=( "${arg#*=}" ) + ;; + + --sign=*) + OVERRIDE_SIGN_KEYID=${arg#*=} + ;; + + --upload=*) + OVERRIDE_UPLOAD_QUEUE=${arg#*=} + ;; + + *.dsc) + DSC="$arg" + ;; + + --help) + usage 0 + ;; + + --version) + version + ;; + + *) + echo "ERROR: unrecognised option '$arg'" + usage 1 + ;; + esac +done + +if [ -z "$REMOTE_SCRIPT" ]; then + echo "No remote script name set. Aborted." + exit 1 +fi +if [ -z "$DSC" ]; then + echo "ERROR: No package .dsc specified" + usage 1 +fi +if ! [ -r "$DSC" ]; then + echo "ERROR: '$DSC' not found." + exit 1 +fi +if [ -z "$BUILDD_ARCH" ]; then + echo "No BUILDD_ARCH set. Aborted." + exit 1 +fi +if [ -z "$BUILDD_HOST" ]; then + echo "No BUILDD_HOST set. Aborted." + exit 1 +fi +if [ -z "$BUILDD_ROOTCMD" ]; then + echo "No BUILDD_ROOTCMD set. Aborted." + exit 1 +fi +if [ -e "$REMOTE_SCRIPT" ]; then + echo "$REMOTE_SCRIPT file already exists and will be overwritten." + echo -n "Do you wish to continue (Y/n)? " + read -e yesno + case "$yesno" in + N* | n*) + echo "Ok, bailing out." + echo "You should set the REMOTE_SCRIPT variable to some other value" + echo "if this name conflicts with something you already expect to use" + exit 1 + ;; + *) ;; + esac +fi + +[ -z "$BUILDD_USER" ] || BUILDD_USER="$BUILDD_USER@" + +PACKAGE="$(basename $DSC .dsc)" +DATE="$(date +%Y%m%d 2>/dev/null)" + + +cat > "$REMOTE_SCRIPT" <<-EOF + #!/bin/bash + # cowpoke generated remote worker script. + # Normally this should have been deleted already, you can safely remove it now. + + compare_changes() + { + p1="\${1%_*.changes}" + p2="\${2%_*.changes}" + p1="\${p1##*_}" + p2="\${p2##*_}" + + dpkg --compare-versions "\$p1" gt "\$p2" + } + + $(get_archdist_vars) + + for arch in $BUILDD_ARCH; do + for dist in $BUILDD_DIST; do + + echo " ------- Begin build for \$arch \$dist -------" + + CHANGES="\$arch.changes" + LOGFILE="$INCOMING_DIR/build.${PACKAGE}_\$arch.\$dist.log" + UPDATELOG="$INCOMING_DIR/cowbuilder-\${arch}-\${dist}-update-log-$DATE" + eval "RESULT_DIR=\"\\\$\${arch}_\${dist}_RESULT_DIR\"" + eval "BASE_PATH=\"\\\$\${arch}_\${dist}_BASE_PATH\"" + eval "BASE_DIST=\"\\\$\${arch}_\${dist}_BASE_DIST\"" + eval "CREATE_OPTS=( \"\\\${\${arch}_\${dist}_CREATE_OPTS[@]}\" )" + eval "UPDATE_OPTS=( \"\\\${\${arch}_\${dist}_UPDATE_OPTS[@]}\" )" + eval "BUILD_OPTS=( \"\\\${\${arch}_\${dist}_BUILD_OPTS[@]}\" )" + + [ -n "\$BASE_DIST" ] || BASE_DIST=\$dist + [ ${#OVERRIDE_CREATE_OPTS[@]} -eq 0 ] || CREATE_OPTS=("${OVERRIDE_CREATE_OPTS[@]}") + [ ${#OVERRIDE_UPDATE_OPTS[@]} -eq 0 ] || UPDATE_OPTS=("${OVERRIDE_UPDATE_OPTS[@]}") + [ ${#OVERRIDE_BUILD_OPTS[@]} -eq 0 ] || BUILD_OPTS=("${OVERRIDE_BUILD_OPTS[@]}") + [ ${#DEBBUILDOPTS[*]} -eq 0 ] || DEBBUILDOPTS=("--debbuildopts" "${DEBBUILDOPTS[*]}") + + + # Sort the list of old changes files for this package to try and + # determine the most recent one preceding this version. We will + # debdiff to this revision in the final sanity checks if one exists. + # This is adapted from the insertion sort trickery in git-debimport. + + OLD_CHANGES="\$(find "\$RESULT_DIR/" -maxdepth 1 -type f \\ + -name "${PACKAGE%%_*}_*_\$CHANGES" 2>/dev/null \\ + | sort 2>/dev/null)" + P=( \$OLD_CHANGES ) + count=\${#P[*]} + + for(( i=1; i < count; ++i )) do + j=i + #echo "was \$i: \${P[i]}" + while ((\$j)) && compare_changes "\${P[j-1]}" "\${P[i]}"; do ((--j)); done + ((i==j)) || P=( \${P[@]:0:j} \${P[i]} \${P[j]} \${P[@]:j+1:i-(j+1)} \${P[@]:i+1} ) + done + #for(( i=1; i < count; ++i )) do echo "now \$i: \${P[i]}"; done + + OLD_CHANGES= + for(( i=count-1; i >= 0; --i )) do + if [ "\${P[i]}" != "\$RESULT_DIR/${PACKAGE}_\$CHANGES" ]; then + OLD_CHANGES="\${P[i]}" + break + fi + done + + + set -eo pipefail + + if ! [ -e "\$BASE_PATH" ]; then + if [ "$CREATE_COW" = "yes" ]; then + mkdir -p "\$RESULT_DIR" + mkdir -p "\$(dirname \$BASE_PATH)" + mkdir -p "$PBUILDER_BASE/aptcache" + $BUILDD_ROOTCMD cowbuilder --create --distribution \$BASE_DIST \\ + --basepath "\$BASE_PATH" \\ + --aptcache "$PBUILDER_BASE/aptcache" \\ + --debootstrap "$DEBOOTSTRAP" \\ + --debootstrapopts --arch="\$arch" \\ + "\${CREATE_OPTS[@]}" \\ + 2>&1 | tee "\$UPDATELOG" + else + echo "SKIPPING \$dist/\$arch build, '\$BASE_PATH' does not exist" | tee "\$LOGFILE" + echo " use the cowpoke --create option to bootstrap a new build root" | tee -a "\$LOGFILE" + continue + fi + elif ! [ -e "\$UPDATELOG" ]; then + $BUILDD_ROOTCMD cowbuilder --update --distribution \$BASE_DIST \\ + --basepath "\$BASE_PATH" \\ + --aptcache "$PBUILDER_BASE/aptcache" \\ + --autocleanaptcache \\ + "\${UPDATE_OPTS[@]}" \\ + 2>&1 | tee "\$UPDATELOG" + fi + $BUILDD_ROOTCMD cowbuilder --build --basepath "\$BASE_PATH" \\ + --aptcache "$PBUILDER_BASE/aptcache" \\ + --buildplace "$PBUILDER_BASE/build" \\ + --buildresult "\$RESULT_DIR" \\ + "\${DEBBUILDOPTS[@]}" \\ + "\${BUILD_OPTS[@]}" \\ + "$INCOMING_DIR/$(basename $DSC)" 2>&1 \\ + | tee "\$LOGFILE" + + set +eo pipefail + + + echo >> "\$LOGFILE" + echo "lintian \$RESULT_DIR/${PACKAGE}_\$CHANGES" >> "\$LOGFILE" + lintian "\$RESULT_DIR/${PACKAGE}_\$CHANGES" 2>&1 | tee -a "\$LOGFILE" + + if [ -n "\$OLD_CHANGES" ]; then + echo >> "\$LOGFILE" + echo "debdiff \$OLD_CHANGES ${PACKAGE}_\$CHANGES" >> "\$LOGFILE" + debdiff "\$OLD_CHANGES" "\$RESULT_DIR/${PACKAGE}_\$CHANGES" 2>&1 \\ + | tee -a "\$LOGFILE" + else + echo >> "\$LOGFILE" + echo "No previous packages for \$dist/\$arch to compare" >> "\$LOGFILE" + fi + + done + done + +EOF +chmod 755 "$REMOTE_SCRIPT" + + +if ! dcmd rsync -vP $DSC "$REMOTE_SCRIPT" "$BUILDD_USER$BUILDD_HOST:$INCOMING_DIR"; +then + dcmd scp $DSC "$REMOTE_SCRIPT" "$BUILDD_USER$BUILDD_HOST:$INCOMING_DIR" +fi + +ssh -t "$BUILDD_USER$BUILDD_HOST" "\"$INCOMING_DIR/$REMOTE_SCRIPT\" && rm -f \"$INCOMING_DIR/$REMOTE_SCRIPT\"" + +echo +echo "Build completed." + +for arch in $BUILDD_ARCH; do + CHANGES="$arch.changes" + for dist in $BUILDD_DIST; do + + sign_keyid=$OVERRIDE_SIGN_KEYID + [ -n "$sign_keyid" ] || eval "sign_keyid=\"\$${arch}_${dist}_SIGN_KEYID\"" + [ -n "$sign_keyid" ] || sign_keyid="$SIGN_KEYID" + [ -n "$sign_keyid" ] || continue + + eval "RESULT_DIR=\"\$${arch}_${dist}_RESULT_DIR\"" + [ -n "$RESULT_DIR" ] || RESULT_DIR="$PBUILDER_BASE/$arch/$dist/result" + + _desc="$dist/$arch" + [ "$dist" != "default" ] || _desc="$arch" + + while true; do + echo -n "Sign $_desc $PACKAGE with key '$sign_keyid' (yes/no)? " + read -e yesno + case "$yesno" in + YES | yes) + debsign "-k$sign_keyid" -r "$BUILDD_USER$BUILDD_HOST" "$RESULT_DIR/${PACKAGE}_$CHANGES" + + upload_queue=$OVERRIDE_UPLOAD_QUEUE + [ -n "$upload_queue" ] || eval "upload_queue=\"\$${arch}_${dist}_UPLOAD_QUEUE\"" + [ -n "$upload_queue" ] || upload_queue="$UPLOAD_QUEUE" + + if [ -n "$upload_queue" ]; then + while true; do + echo -n "Upload $_desc $PACKAGE to '$upload_queue' (yes/no)? " + read -e upload + case "$upload" in + YES | yes) + ssh "$BUILDD_USER$BUILDD_HOST" \ + "cd \"$RESULT_DIR/\" && dput \"$upload_queue\" \"${PACKAGE}_$CHANGES\"" + break 2 + ;; + + NO | no) + echo "Package upload skipped." + break 2 + ;; + *) + echo "Please answer 'yes' or 'no'" + ;; + esac + done + fi + break + ;; + + NO | no) + echo "Package signing skipped." + break + ;; + *) + echo "Please answer 'yes' or 'no'" + ;; + esac + done + done +done + +if [ -n "$RETURN_DIR" ]; then + for arch in $BUILDD_ARCH; do + CHANGES="$arch.changes" + for dist in $BUILDD_DIST; do + + eval "RESULT_DIR=\"\$${arch}_${dist}_RESULT_DIR\"" + [ -n "$RESULT_DIR" ] || RESULT_DIR="$PBUILDER_BASE/$arch/$dist/result" + + + cache_dir="./cowpoke-return-cache" + mkdir -p $cache_dir + + scp "$BUILDD_USER$BUILDD_HOST:$RESULT_DIR/${PACKAGE}_$CHANGES" $cache_dir + + for f in $(cd $cache_dir && dcmd ${PACKAGE}_$CHANGES); do + RESULTS="$RESULTS $RESULT_DIR/$f" + done + + rm -f $cache_dir/${PACKAGE}_$CHANGES + rmdir $cache_dir + + + if ! rsync -vP "$BUILDD_USER$BUILDD_HOST:$RESULTS" "$RETURN_DIR" ; + then + scp "$BUILDD_USER$BUILDD_HOST:$RESULTS" "$RETURN_DIR" + fi + + done + done +fi + +rm -f "$REMOTE_SCRIPT" + +# vi:sts=4:sw=4:noet:foldmethod=marker diff --git a/scripts/cvs-debc.1 b/scripts/cvs-debc.1 new file mode 100644 index 0000000..98a399e --- /dev/null +++ b/scripts/cvs-debc.1 @@ -0,0 +1,67 @@ +.TH CVS-DEBC 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +cvs-debc \- view contents of a cvs-buildpackage/cvs-debuild generated package +.SH SYNOPSIS +\fBcvs-debc\fP [\fIoptions\fR] [\fIpackage\fR ...] +.SH DESCRIPTION +\fBcvs-debc\fR is run from the CVS working directory after +\fBcvs-buildpackage\fR or \fBcvs-debuild\fR. It uses the +\fBcvs-buildpackage\fR system to locate the \fI.changes\fR file +generated in that run. It then displays information about the \fI.deb\fR +files which were generated in that run, by running \fBdpkg-deb \-I\fR +and \fBdpkg-deb \-c\fR on every \fI.deb\fR archive listed in +the \fI.changes\fR file, assuming that all of the \fI.deb\fR archives +live in the same directory as the \fI.changes\fR file. It is +useful for ensuring that the expected files have ended up in the +Debian package. +.PP +If a list of packages is given on the command line, then only those +debs with names in this list of packages will be processed. +.PP +Note that unlike \fBcvs-buildpackage\fR, the only way to specify the +source package name is with the \fB\-P\fR option; you cannot simply +have it as the last command-line parameter. +.SH OPTIONS +All current \fBcvs-buildpackage\fR options are silently accepted; +however, only the ones listed below have any effect. For more details +on all of them, see the \fBcvs-buildpackage\fR(1) manpage. +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. +.TP +.BR \-M\fImodule +The name of the CVS module. +.TP +.BR \-P\fIpackage +The name of the package. +.TP +.B \-V\fIversion +The version number of the package. +.TP +.B \-T\fItag +The CVS tag to use for exporting sources. +.TP +.B \-R\fIroot\ directory +Root of the original sources archive. +.TP +.B \-W\fIwork directory +The full path name for the cvs-buildpackage working directory. +.TP +.B \-x\fIprefix +This option provides the CVS default module prefix. +.TP +\fB\-\-help\fR, \fB\-\-version\fR +Show help message and version information respectively. +.SH "SEE ALSO" +.BR cvs-buildpackage (1), +.BR cvs-debi (1), +.BR cvs-debuild (1), +.BR debc (1) +.SH AUTHOR +\fBcvs-buildpackage\fR was written by Manoj Srivastava, and the +current version of \fBdebi\fR was written by Julian Gilbey +<jdg@debian.org>. They have been combined into this program by +Julian Gilbey. diff --git a/scripts/cvs-debi.1 b/scripts/cvs-debi.1 new file mode 100644 index 0000000..bb0ac8c --- /dev/null +++ b/scripts/cvs-debi.1 @@ -0,0 +1,71 @@ +.TH CVS-DEBI 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +cvs-debi \- install cvs-buildpackage/cvs-debuild generated package +.SH SYNOPSIS +\fBcvs-debi\fP [\fIoptions\fR] [\fIpackage\fR ...] +.SH DESCRIPTION +\fBcvs-debi\fR is run from the CVS working directory after +\fBcvs-buildpackage\fR or \fBcvs-debuild\fR. It uses the +\fBcvs-buildpackage\fR system to locate the \fI.changes\fR file +generated in that run. It then runs \fBdebpkg \-i\fR on +every \fI.deb\fR archive listed in the \fI.changes\fR file to install +them, assuming that all of the \fI.deb\fR archives live in the same +directory as the \fI.changes\fR file. Note that you probably don't +want to run this program on a \fI.changes\fR file relating to a +different architecture after cross-compiling the package! +.PP +If a list of packages is given on the command line, then only those +debs with names in this list of packages will be installed. +.PP +Note that unlike \fBcvs-buildpackage\fR, the only way to specify the +source package name is with the \fB\-P\fR option; you cannot simply +have it as the last command-line parameter. +.PP +Since installing a package requires root privileges, \fBdebi\fR calls +\fBdebpkg\fR rather than \fBdpkg\fR directly. Thus \fBdebi\fR will +only be useful if it is either being run as root or \fBdebpkg\fR can +be run as root. See \fBdebpkg\fR(1) for more details. +.SH OPTIONS +All current \fBcvs-buildpackage\fR options are silently accepted; +however, only the ones listed below have any effect. For more details +on all of them, see the \fBcvs-buildpackage\fR(1) manpage. +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. +.TP +.BR \-M\fImodule +The name of the CVS module. +.TP +.BR \-P\fIpackage +The name of the package. +.TP +.B \-V\fIversion +The version number of the package. +.TP +.B \-T\fItag +The CVS tag to use for exporting sources. +.TP +.B \-R\fIroot\ directory +Root of the original sources archive. +.TP +.B \-W\fIwork directory +The full path name for the cvs-buildpackage working directory. +.TP +.B \-x\fIprefix +This option provides the CVS default module prefix. +.TP +\fB\-\-help\fR, \fB\-\-version\fR +Show help message and version information respectively. +.SH "SEE ALSO" +.BR cvs-buildpackage (1), +.BR cvs-debc (1), +.BR cvs-debuild (1), +.BR debi (1) +.SH AUTHOR +\fBcvs-buildpackage\fR was written by Manoj Srivastava, and the +current version of \fBdebi\fR was written by Julian Gilbey +<jdg@debian.org>. They have been combined into this program by +Julian Gilbey. diff --git a/scripts/cvs-debi.sh b/scripts/cvs-debi.sh new file mode 100755 index 0000000..573867f --- /dev/null +++ b/scripts/cvs-debi.sh @@ -0,0 +1,370 @@ +#!/bin/bash + +# cvs-debi: Install current version of deb package +# cvs-debc: List contents of current version of deb package +# +# Based on debi/debc; see them for copyright information +# Based on cvs-buildpackage, copyright 1997 Manoj Srivastava +# (CVS Id: cvs-buildpackage,v 1.58 2003/08/22 17:24:29 srivasta Exp) +# This code is copyright 2003, Julian Gilbey <jdg@debian.org> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +set -e + +PROGNAME=`basename $0 .sh` # .sh for debugging purposes + +usage () { + if [ "$PROGNAME" = cvs-debi ]; then usage_i + elif [ "$PROGNAME" = cvs-debc ]; then usage_c + else echo "Unrecognised invocation name: $PROGNAME" >&2; exit 1 + fi; +} + +usage_i () { + echo \ +"Usage: $PROGNAME [options] [package ...] + Install the .deb file(s) just created by cvs-buildpackage or cvs-debuild, + as listed in the .changes file generated on that run. If packages are + listed, only install those specified binary packages from the .changes file. + + Note that unlike cvs-buildpackage, the only way to specify the + source package name is with the -P option; you cannot simply have it + as the last parameter. + + Also uses the cvs-buildpackage configuration files to determine the + location of the build tree, as described in the manpage. + + Available options: + -M<module> CVS module name + -P<package> Package name + -V<version> Package version + -T<tag> CVS tag to use + -R<root dir> Root directory + -W<work dir> Working directory + -x<prefix> CVS default module prefix + -a<arch> Search for .changes file made for Debian build <arch> + -t<target> Search for .changes file made for GNU <target> arch + --help Show this message + --version Show version and copyright information + Other cvs-buildpackage options will be silently ignored." +} + +usage_c () { + echo \ +"Usage: $PROGNAME [options] [package ...] + Display the contents of the .deb file(s) just created by + cvs-buildpackage or cvs-debuild, as listed in the .changes file generated + on that run. If packages are listed, only display those specified binary + packages from the .changes file. + + Note that unlike cvs-buildpackage, the only way to specify the + source package name is with the -P option; you cannot simply have it + as the last parameter. + + Also uses the cvs-buildpackage configuration files to determine the + location of the build tree, as described in its manpage. + + Available options: + -M<module> CVS module name + -P<package> Package name + -V<version> Package version + -T<tag> CVS tag to use + -R<root dir> Root directory + -W<work dir> Working directory + -x<prefix> CVS default module prefix + -a<arch> Search for .changes file made for Debian build <arch> + -t<target> Search for .changes file made for GNU <target> arch + --help Show this message + --version Show version and copyright information + Other cvs-buildpackage options will be silently ignored." +} + +version () { echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is copyright 2003, Julian Gilbey <jdg@debian.org>, +all rights reserved. +Based on original code by Christoph Lameter and Manoj Srivastava. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of +the GNU General Public License, version 2 or later." +} + +setq() { + # Variable Value Doc string + if [ "x$2" = "x" ]; then + echo >&2 "$progname: Unable to determine $3" + exit 1; + else + if [ ! "x$Verbose" = "x" ]; then + echo "$progname: $3 is $2"; + fi + eval "$1=\"\$2\""; + fi +} + +# Is cvs-buildpackage installed? +if ! command -v cvs-buildpackage >/dev/null 2>&1; then + echo "$PROGNAME: need the cvs-buildpackage package installed to run this" >&2 + exit 1 +fi + +# Long term variables, which may be set in the cvsdeb config file or the +# environment: +# rootdir workdir (if all original sources are kept in one dir) + +TEMPDIR=$(mktemp -dt cvs-debi.XXXXXXXX) || { + echo "$PROGNAME: unable to create temporary directory" >&2 + echo "Aborting..." >&2 + exit 1 +} +TEMPFILE=$TEMPDIR/cl-tmp +trap 'rm -f "$TEMPFILE"; rmdir "$TEMPDIR"' EXIT + +TAGOPT= + +# Command line; will bomb out if unrecognised options +TEMP=$(getopt -a -s bash \ + -o hC:EH:G:M:P:R:T:U:V:W:Ff:dcnr:x:Bp:Dk:a:Sv:m:e:i:I:t: \ + --long help,version,ctp,tC,sgpg,spgp,us,uc,op \ + --long si,sa,sd,ap,sp,su,sk,sr,sA,sP,sU,sK,sR,ss,sn \ + -n "$PROGNAME" -- "$@") +eval set -- $TEMP + +while true ; do + case "$1" in + -h|--help) usage; exit 0 ; shift ;; + --version) version; exit 0 ; shift ;; + -M) opt_cvsmodule="$2" ; shift 2 ;; + -P) opt_package="$2" ; shift 2 ;; + -R) opt_rootdir="$2" ; shift 2 ;; + -T) opt_tag="$2" ; shift 2 ;; + -V) opt_version="$2" ; shift 2 ;; + -W) opt_workdir="$2" ; shift 2 ;; + -x) opt_prefix="$2" ; shift 2 ;; + -a) targetarch="$2" ; shift 2 ;; + -t) if [ "$2" != "C" ]; then targetgnusystem="$2"; fi + shift 2 ;; + + # everything else is silently ignored + -[CHfGUr]) shift 2 ;; + -[FnE]) shift ;; + --ctp|--op|--tC) shift ;; + -[dDBbS]) shift ;; + -p) shift 2 ;; + --us|--uc|--sgpg|--spgp) shift ;; + --s[idapukrAPUKRns]) shift ;; + --ap) shift ;; + -[kvmeiI]) shift 2 ;; + + --) shift ; break ;; + *) echo >&2 "Internal error! ($1)" + usage; exit 1 ;; + esac +done + +if [ "x$opt_cvsmodule" = "x" -a "x$opt_package" = "x" -a \ + ! -e 'debian/changelog' ] ; then + echo >&2 "$progname should be run in the top working directory of" + echo >&2 "a Debian Package, or an explicit package (or CVS module) name" + echo >&2 "should be given." + exit 1 +fi + +if [ "x$opt_tag" != "x" ]; then + TAGOPT=-r$opt_tag +fi + +# Command line, env variable, config file, or default +# This anomalous position is in case we need to check out the changelog +# below (anomalous since we have not loaded the config file yet) +if [ ! "x$opt_prefix" = "x" ]; then + prefix="$opt_prefix" +elif [ ! "x$CVSDEB_PREFIX" = "x" ]; then + prefix="$CVSDEB_PREFIX" +elif [ ! "x$conf_prefix" = "x" ]; then + prefix="$conf_prefix" +else + prefix="" +fi + +# put a slash at the end of the prefix +if [ "X$prefix" != "X" ]; then + prefix="$prefix/"; + prefix=`echo $prefix | sed 's://:/:g'`; +fi + +if [ ! -f CVS/Root ]; then + if [ "X$CVSROOT" = "X" ]; then + echo "no CVS/Root file found, and CVSROOT var is empty" >&2 + exit 1 + fi +else + CVSROOT=$(cat CVS/Root) + export CVSROOT +fi + +if [ "x$opt_package" = "x" ]; then + # Get the official package name and version. + if [ -f debian/changelog ]; then + # Ok, changelog exists + setq "package" \ + "`dpkg-parsechangelog -SSource`" \ + "source package" + setq "version" \ + "`dpkg-parsechangelog -SVersion`" \ + "source version" + elif [ "x$opt_cvsmodule" != "x" ]; then + # Hmm. Well, see if we can checkout the changelog file + rm -f $TEMPFILE + cvs -q co -p $TAGOPT $opt_cvsmodule/debian/changelog > $TEMPFILE + setq "package" \ + "`dpkg-parsechangelog -l$TEMPFILE -SSource`" \ + "source package" + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + else + # Well. We don't know what this package is. + echo >&2 " This does not appear be a Debian source tree, since" + echo >&2 " there is no debian/changelog, and there was no" + echo >&2 " package name or cvs module given on the command line" + echo >&2 " it is hard to figure out what the package name " + echo >&2 " should be. I give up." + exit 1 + fi +else + # The user knows best; package name is provided + setq "package" "$opt_package" "source package" + + # Now, the version number + if [ "x$opt_version" != "x" ]; then + # All hail the user provided value + setq "version" "$opt_version" "source package" + elif [ -f debian/changelog ]; then + # Fine, see what the changelog says + setq "version" \ + "`dpkg-parsechangelog -SVersion`" \ + "source version" + elif [ "x$opt_cvsmodule" != "x" ]; then + # Hmm. The CVS module name is known, so lets us try exporting changelog + rm -f $TEMPFILE + cvs -q co -p $TAGOPT $opt_cvsmodule/debian/changelog > $TEMPFILE + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + else + # Ok, try exporting the package name + rm -f $TEMPFILE + cvsmodule="${prefix}$package" + cvs -q co -p $TAGOPT $cvsmodule/debian/changelog > $TEMPFILE + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + fi +fi + +rm -f $TEMPFILE +rmdir $TEMPDIR +trap "" 0 1 2 3 7 10 13 15 + + +non_epoch_version=$(echo -n "$version" | perl -pe 's/^\d+://') +upstream_version=$(echo -n "$non_epoch_version" | sed -e 's/-[^-]*$//') +debian_version=$(echo -n $non_epoch_version | perl -nle 'm/-([^-]*)$/ && print $1') + +# The default +if [ "X$opt_rootdir" != "X" ]; then + rootdir="$opt_rootdir" +else + rootdir='/usr/local/src/Packages' +fi + +if [ "X$opt_workdir" != "X" ]; then + workdir="$opt_workdir" +else + workdir="$rootdir/$package" +fi + +# Load site defaults and over rides. +if [ -f /etc/cvsdeb.conf ]; then + . /etc/cvsdeb.conf +fi + +# Load user defaults and over rides. +if [ -f ~/.cvsdeb.conf ]; then + . ~/.cvsdeb.conf +fi + +# Command line, env variable, config file, or default +if [ ! "x$opt_rootdir" = "x" ]; then + rootdir="$opt_rootdir" +elif [ ! "x$CVSDEB_ROOTDIR" = "x" ]; then + rootdir="$CVSDEB_ROOTDIR" +elif [ ! "x$conf_rootdir" = "x" ]; then + rootdir="$conf_rootdir" +fi + +# Command line, env variable, config file, or default +if [ ! "x$opt_workdir" = "x" ]; then + workdir="$opt_workdir" +elif [ ! "x$CVSDEB_WORKDIR" = "x" ]; then + workdir="$CVSDEB_WORKDIR" +elif [ ! "x$conf_workdir" = "x" ]; then + workdir="$conf_workdir" +else + workdir="$rootdir/$package" +fi + +if [ ! -d "$workdir" ]; then + echo >&2 "The working directory, $workdir, does not exist. Aborting." + if [ ! -d "$rootdir" ]; then + echo >&2 "The root directory, $rootdir, does not exist either." + fi + exit 1; +fi + +# The next part is based on debi + +if [ -n "$targetarch" ] && [ -n "$targetgnusystem" ]; then + setq arch "$(dpkg-architecture "-a${targetarch}" "-t${targetgnusystem}" -qDEB_HOST_ARCH)" "build architecture" +elif [ -n "$targetarch" ]; then + setq arch "$(dpkg-architecture "-a${targetarch}" -qDEB_HOST_ARCH)" "build architecture" +elif [ -n "$targetgnusystem" ]; then + setq arch "$(dpkg-architecture "-t${targetgnusystem}" -qDEB_HOST_ARCH)" "build architecture" +else + setq arch "$(dpkg-architecture -qDEB_HOST_ARCH)" "build architecture" +fi + +pva="${package}_${non_epoch_version}_${arch}" +changes="$pva.changes" + +cd $workdir || { + echo "Couldn't cd $workdir. Aborting" >&2 + exit 1 +} + +if [ ! -r "$changes" ]; then + echo "Can't read $workdir/$changes! Have you built the package yet?" >&2 + exit 1 +fi + +# Just call debc/debi respectively, now that we have a changes file + +SUBPROG=${PROGNAME#cvs-} + +exec $SUBPROG --check-dirname-level 0 $changes "$@" diff --git a/scripts/cvs-debrelease.1 b/scripts/cvs-debrelease.1 new file mode 100644 index 0000000..c911b0d --- /dev/null +++ b/scripts/cvs-debrelease.1 @@ -0,0 +1,72 @@ +.TH CVS-DEBC 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +cvs-debrelease \- upload a cvs-buildpackage/cvs-debuild generated package +.SH SYNOPSIS +\fBcvs-debrelease\fP [\fIcvs-debrelease options\fR] [\fB\-\-dopts\fR +[\fIdupload/dput options\fR]] +.SH DESCRIPTION +\fBcvs-debrelease\fR is run from the CVS working directory after +\fBcvs-buildpackage\fR or \fBcvs-debuild\fR. It uses the +\fBcvs-buildpackage\fR system to locate the \fI.changes\fR file +generated in that run. It then uploads the package using +\fBdebrelease\fR(1), which in turn calls either \fBdupload\fR or +\fBdput\fR. Note that the \fB\-\-dopts\fR option must be specified to +distinguish the \fBcvs-debrelease\fR options from the \fBdupload\fR or +\fBdput\fR options. Also, the \fBdevscripts\fR configuration files +will be read, as described in the \fBdebrelease\fR(1) manpage. +.PP +Note that unlike \fBcvs-buildpackage\fR, the only way to specify the +source package name is with the \fB\-P\fR option; you cannot simply +have it as the last command-line parameter. +.SH OPTIONS +All current \fBcvs-buildpackage\fR options are silently accepted; +however, only the ones listed below have any effect. For more details +on all of them, see the \fBcvs-buildpackage\fR(1) manpage. All +\fBdebrelease\fR options (as listed below) are also accepted. +.TP +\fB\-\-dupload\fR, \fB\-\-dput\fR +This specifies which uploader program to use; the default is +\fBdupload\fR. +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. +.TP +.BR \-M\fImodule +The name of the CVS module. +.TP +.BR \-P\fIpackage +The name of the package. +.TP +.B \-V\fIversion +The version number of the package. +.TP +.B \-T\fItag +The CVS tag to use for exporting sources. +.TP +.B \-R\fIroot\ directory +Root of the original sources archive. +.TP +.B \-W\fIwork directory +The full path name for the cvs-buildpackage working directory. +.TP +.B \-x\fIprefix +This option provides the CVS default module prefix. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +\fB\-\-help\fR, \fB\-\-version\fR +Show help message and version information respectively. +.SH "SEE ALSO" +.BR cvs-buildpackage (1), +.BR cvs-debuild (1), +.BR debrelease (1) +.SH AUTHOR +\fBcvs-buildpackage\fR was written by Manoj Srivastava, and the +current version of \fBdebrelease\fR was written by Julian Gilbey +<jdg@debian.org>. They have been combined into this program by +Julian Gilbey. diff --git a/scripts/cvs-debrelease.sh b/scripts/cvs-debrelease.sh new file mode 100755 index 0000000..bc6519d --- /dev/null +++ b/scripts/cvs-debrelease.sh @@ -0,0 +1,385 @@ +#!/bin/bash + +# cvs-debrelease: Call dupload/dput to upload package built with +# cvs-buildpackage or cvs-debuild +# +# Based on debrelease; see it for copyright information +# Based on cvs-buildpackage, copyright 1997 Manoj Srivastava +# (CVS Id: cvs-buildpackage,v 1.58 2003/08/22 17:24:29 srivasta Exp) +# This code is copyright 2003, Julian Gilbey <jdg@debian.org> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +set -e + +PROGNAME=`basename $0 .sh` # .sh for debugging purposes + +usage () { + echo \ +"Usage: $PROGNAME [cvs-debrelease options] [--dopts [dupload/dput options]] + Upload the .changes file(s) just created by cvs-buildpackage or + cvs-debuild, as listed in the .changes file generated on that run. + + Note that unlike cvs-buildpackage, the only way to specify the + source package name is with the -P option; you cannot simply have it + as the last parameter. + + Also uses the cvs-buildpackage configuration files to determine the + location of the build tree, as described in its manpage. + + Available cvs-debrelease options: + -M<module> CVS module name + -P<package> Package name + -V<version> Package version + -T<tag> CVS tag to use + -R<root dir> Root directory + -W<work dir> Working directory + -x<prefix> CVS default module prefix + -a<arch> Search for .changes file made for Debian build <arch> + -t<target> Search for .changes file made for GNU <target> arch + --dupload Use dupload to upload files (default) + --dput Use dput to upload files + --no-conf, --noconf + Don't read devscripts config files; + must be the first option given + --dopts The remaining options are for dupload/dput + --help Show this message + --version Show version and copyright information + Other cvs-buildpackage options will be silently ignored. + +Default settings modified by devscripts configuration files: + (no configuration files are read by $PROGNAME) +For information on default debrelease settings modified by the +configuration files, run: debrelease --help" +} + + +version () { echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is copyright 2003, Julian Gilbey <jdg@debian.org>, +all rights reserved. +Based on original code by Christoph Lameter and Manoj Srivastava. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of +the GNU General Public License, version 2 or later." +} + +setq() { + # Variable Value Doc string + if [ "x$2" = "x" ]; then + echo >&2 "$progname: Unable to determine $3" + exit 1; + else + if [ ! "x$Verbose" = "x" ]; then + echo "$progname: $3 is $2"; + fi + eval "$1=\"\$2\""; + fi +} + +# Is cvs-buildpackage installed? +if ! command -v cvs-buildpackage >/dev/null 2>&1; then + echo "$PROGNAME: need the cvs-buildpackage package installed to run this" >&2 + exit 1 +fi + +# Long term variables, which may be set in the cvsdeb config file or the +# environment: +# rootdir workdir (if all original sources are kept in one dir) + +TEMPDIR=$(mktemp -dt cvs-debrelease.XXXXXXXX) || { + echo "$PROGNAME: Unable to create temporary directory" >&2 + echo "Aborting...." >&2 + exit 1 +} +TEMPFILE=$TEMPDIR/cl-tmp +trap 'rm -f "$TEMPFILE"; rmdir "$TEMPDIR"' EXIT + +TAGOPT= + +# Command line +# Start by pulling off all options up to --dopts +declare -a cvsopts debreleaseopts +if [ "$1" = --no-conf -o "$1" = --noconf ]; then + debreleaseopts=("$1") + shift +fi + +debreleaseopts=("${debreleaseopts[@]}" "--check-dirname-level=0") + +while [ $# -gt 0 ]; do + if [ "$1" = "--dopts" ]; then + shift + break + fi + cvsopts=("${cvsopts[@]}" "$1") + shift +done + +# This will bomb out if there is an unrecognised option +TEMP=$(getopt -a -s bash \ + -o hC:EH:G:M:P:R:T:U:V:W:Ff:dcnr:x:Bp:Dk:a:Sv:m:e:i:I:t: \ + --long help,version,ctp,tC,sgpg,spgp,us,uc,op \ + --long si,sa,sd,ap,sp,su,sk,sr,sA,sP,sU,sK,sR,ss,sn \ + --long dupload,dput,no-conf,noconf \ + --long check-dirname-level:,check-dirname-regex: \ + -n "$PROGNAME" -- "${cvsopts[@]}") + +eval set -- $TEMP + +while true ; do + case "$1" in + -h|--help) usage; exit 0 ; shift ;; + --version) version; exit 0 ; shift ;; + -M) opt_cvsmodule="$2" ; shift 2 ;; + -P) opt_package="$2" ; shift 2 ;; + -R) opt_rootdir="$2" ; shift 2 ;; + -T) opt_tag="$2" ; shift 2 ;; + -V) opt_version="$2" ; shift 2 ;; + -W) opt_workdir="$2" ; shift 2 ;; + -x) opt_prefix="$2" ; shift 2 ;; + -a) debreleaseopts=("${debreleaseopts[@]}" "$1" "$2") + targetarch="$2" ; shift 2 ;; + -t) if [ "$2" != "C" ]; then + debreleaseopts=("${debreleaseopts[@]}" "$1" "$2") + targetgnusystem="$2" + fi + shift 2 ;; + --dupload|--dput) + debreleaseopts=("${debreleaseopts[@]}" "$1"); shift ;; + --no-conf|--noconf) + echo "$PROGNAME: $1 is only acceptable as the first command-line option!" >&2 + exit 1 ;; + --check-dirname-level|--check-dirname-regex) + debreleaseopts=("${debreleaseopts[@]}" "$1" "$2"); shift 2 ;; + + # everything else is silently ignored + -[CHfGUr]) shift 2 ;; + -[FnE]) shift ;; + --ctp|--op|--tC) shift ;; + -[dDBbS]) shift ;; + -p) shift 2 ;; + --us|--uc|--sgpg|--spgp) shift ;; + --s[idapukrAPUKRns]) shift ;; + --ap) shift ;; + -[kvmeiI]) shift 2 ;; + + --) shift ; break ;; + *) echo >&2 "Internal error! ($1)" + usage; exit 1 ;; + esac +done + +if [ "x$opt_cvsmodule" = "x" -a "x$opt_package" = "x" -a \ + ! -e 'debian/changelog' ] ; then + echo >&2 "$progname should be run in the top working directory of" + echo >&2 "a Debian Package, or an explicit package (or CVS module) name" + echo >&2 "should be given." + exit 1 +fi + +if [ "x$opt_tag" != "x" ]; then + TAGOPT=-r$opt_tag +fi + +# Command line, env variable, config file, or default +# This anomalous position is in case we need to check out the changelog +# below (anomalous since we have not loaded the config file yet) +if [ ! "x$opt_prefix" = "x" ]; then + prefix="$opt_prefix" +elif [ ! "x$CVSDEB_PREFIX" = "x" ]; then + prefix="$CVSDEB_PREFIX" +elif [ ! "x$conf_prefix" = "x" ]; then + prefix="$conf_prefix" +else + prefix="" +fi + +# put a slash at the end of the prefix +if [ "X$prefix" != "X" ]; then + prefix="$prefix/"; + prefix=`echo $prefix | sed 's://:/:g'`; +fi + +if [ ! -f CVS/Root ]; then + if [ "X$CVSROOT" = "X" ]; then + echo "no CVS/Root file found, and CVSROOT var is empty" >&2 + exit 1 + fi +else + CVSROOT=$(cat CVS/Root) + export CVSROOT +fi + +if [ "x$opt_package" = "x" ]; then + # Get the official package name and version. + if [ -f debian/changelog ]; then + # Ok, changelog exists + setq "package" \ + "`dpkg-parsechangelog -SSource`" \ + "source package" + setq "version" \ + "`dpkg-parsechangelog -SVersion`" \ + "source version" + elif [ "x$opt_cvsmodule" != "x" ]; then + # Hmm. Well, see if we can checkout the changelog file + rm -f $TEMPFILE + cvs -q co -p $TAGOPT $opt_cvsmodule/debian/changelog > $TEMPFILE + setq "package" \ + "`dpkg-parsechangelog -l$TEMPFILE -SSource`" \ + "source package" + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + else + # Well. We don't know what this package is. + echo >&2 " This does not appear be a Debian source tree, since" + echo >&2 " there is no debian/changelog, and there was no" + echo >&2 " package name or cvs module given on the command line" + echo >&2 " it is hard to figure out what the package name " + echo >&2 " should be. I give up." + exit 1 + fi +else + # The user knows best; package name is provided + setq "package" "$opt_package" "source package" + + # Now, the version number + if [ "x$opt_version" != "x" ]; then + # All hail the user provided value + setq "version" "$opt_version" "source package" + elif [ -f debian/changelog ]; then + # Fine, see what the changelog says + setq "version" \ + "`dpkg-parsechangelog -SVersion`" \ + "source version" + elif [ "x$opt_cvsmodule" != "x" ]; then + # Hmm. The CVS module name is known, so lets us try exporting changelog + rm -f $TEMPFILE + cvs -q co -p $TAGOPT $opt_cvsmodule/debian/changelog > $TEMPFILE + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + else + # Ok, try exporting the package name + rm -f $TEMPFILE + cvsmodule="${prefix}$package" + cvs -q co -p $TAGOPT $cvsmodule/debian/changelog > $TEMPFILE + setq "version" \ + "`dpkg-parsechangelog -l$TEMPFILE -SVersion`" \ + "source version" + rm -f "$TEMPFILE" + fi +fi + +rm -f $TEMPFILE +rmdir $TEMPDIR +trap "" 0 1 2 3 7 10 13 15 + + +non_epoch_version=$(echo -n "$version" | perl -pe 's/^\d+://') +upstream_version=$(echo -n "$non_epoch_version" | sed -e 's/-[^-]*$//') +debian_version=$(echo -n $non_epoch_version | perl -nle 'm/-([^-]*)$/ && print $1') + +# The default +if [ "X$opt_rootdir" != "X" ]; then + rootdir="$opt_rootdir" +else + rootdir='/usr/local/src/Packages' +fi + +if [ "X$opt_workdir" != "X" ]; then + workdir="$opt_workdir" +else + workdir="$rootdir/$package" +fi + +# Load site defaults and over rides. +if [ -f /etc/cvsdeb.conf ]; then + . /etc/cvsdeb.conf +fi + +# Load user defaults and over rides. +if [ -f ~/.cvsdeb.conf ]; then + . ~/.cvsdeb.conf +fi + +# Command line, env variable, config file, or default +if [ ! "x$opt_rootdir" = "x" ]; then + rootdir="$opt_rootdir" +elif [ ! "x$CVSDEB_ROOTDIR" = "x" ]; then + rootdir="$CVSDEB_ROOTDIR" +elif [ ! "x$conf_rootdir" = "x" ]; then + rootdir="$conf_rootdir" +fi + +# Command line, env variable, config file, or default +if [ ! "x$opt_workdir" = "x" ]; then + workdir="$opt_workdir" +elif [ ! "x$CVSDEB_WORKDIR" = "x" ]; then + workdir="$CVSDEB_WORKDIR" +elif [ ! "x$conf_workdir" = "x" ]; then + workdir="$conf_workdir" +else + workdir="$rootdir/$package" +fi + +if [ ! -d "$workdir" ]; then + echo >&2 "The working directory, $workdir, does not exist. Aborting" + if [ ! -d "$rootdir" ]; then + echo >&2 "The root directory, $rootdir, does not exist either." + fi + exit 1; +fi + +pkgdir="$workdir/$package-$upstream_version" + +if [ ! -d "$pkgdir" ]; then + echo "The build directory $pkgdir does not exist!" >&2 + echo "Have you built the package yet?" >&2 + exit 1 +fi + +if [ -n "$targetarch" ] && [ -n "$targetgnusystem" ]; then + setq arch "$(dpkg-architecture "-a${targetarch}" "-t${targetgnusystem}" -qDEB_HOST_ARCH)" "build architecture" +elif [ -n "$targetarch" ]; then + setq arch "$(dpkg-architecture "-a${targetarch}" -qDEB_HOST_ARCH)" "build architecture" +elif [ -n "$targetgnusystem" ]; then + setq arch "$(dpkg-architecture "-t${targetgnusystem}" -qDEB_HOST_ARCH)" "build architecture" +else + setq arch "$(dpkg-architecture -qDEB_HOST_ARCH)" "build architecture" +fi + +pva="${package}_${non_epoch_version}_${arch}" +changes="$pva.changes" + +if [ ! -f "$workdir/$changes" ]; then + echo "Can't find $workdir/$changes!" >&2 + echo "Have you built the package yet?" >&2 + exit 1 +fi + + +cd $pkgdir || { + echo "Couldn't cd $pkgdir. Aborting" >&2 + exit 1 +} + +# Just call debrelease, now that we are in the correct directory + +SUBPROG=${PROGNAME#cvs-} + +exec $SUBPROG "${debreleaseopts[@]}" "$@" diff --git a/scripts/cvs-debuild.1 b/scripts/cvs-debuild.1 new file mode 100644 index 0000000..bd4712a --- /dev/null +++ b/scripts/cvs-debuild.1 @@ -0,0 +1,59 @@ +.TH CVS-DEBUILD 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +cvs-debuild \- build a Debian package using cvs-buildpackage and debuild +.SH SYNOPSIS +\fBcvs-debuild\fR [\fIdebuild options\fR] [\fIcvs-buildpackage options\fR] +[\fB\-\-lintian-opts\fR \fIlintian options\fR] +.SH DESCRIPTION +\fBcvs-debuild\fR is a wrapper around \fBcvs-buildpackage\fR to run it +with \fBdebuild\fR as the package-building program. (This cannot +simply be accomplished using the \fB\-C\fR option of +\fBcvs-buildpackage\fR, as it does not know how to handle all of the +special \fBdebuild\fR options.) +.PP +The program simply stashes the \fBdebuild\fR and \fBlintian\fR +options, and passes them to \fBdebuild\fR when it is +called by \fBcvs-buildpackage\fR. All of the standard \fBdebuild\fR +options may be used (as listed below), but note that the root command +specified by any \fB\-\-rootcmd\fR or \fB\-r\fR command-line option +will be passed as an option to \fBcvs-buildpackage\fR. The first +non-\fBdebuild\fR option detected will signal the start of the +\fBcvs-buildpackage\fR options. +.PP +The selection of the root command is slightly subtle: if there are any +command-line options, these will be used. If not, then if +\fBcvs-buildpackage\fR is set up to use a default root command, that +will be used. Finally, if neither of these are the case, then +\fBdebuild\fR will use its procedures to determine an appropriate +command, as described in its documentation. +.PP +See the manpages for \fBdebuild\fR(1) and \fBcvs-buildpackage\fR for +more information about the behaviour of each. +.SH "OPTIONS" +The following are the \fBdebuild\fR options recognised by +\fBcvs-debuild\fR. All \fBcvs-buildpackage\fR and \fBlintian\fR +options are simply passed to the appropriate program. For +explanations of the meanings of these variables, see +\fBdebuild\fR(1). +.TP +.B \-\-no\-conf\fR, \fB\-\-noconf +.TP +.BI \-\-rootcmd= "gain-root-command\fR, \fP" \-r gain-root-command +.TP +.B \-\-preserve\-env +.TP +.BI \-\-preserve\-envvar= "var\fR, \fP" \-e var +.TP +.BI \-\-set\-envvar= var = "value\fR, \fP" \-e var = value +.TP +.B \-\-lintian\fR, \fB\-\-no\-lintian +.TP +\fB\-\-ignore-dirname\fR, \fB\-\-check-dirname\fR +These should not be needed, but it is provided nevertheless. +.SH "SEE ALSO" +.BR cvs-buildpackage (1), +.BR debuild (1), +.BR dpkg-buildpackage (1), +.BR lintian (1) +.SH AUTHOR +This program was written by Julian Gilbey <jdg@debian.org>. diff --git a/scripts/cvs-debuild.pl b/scripts/cvs-debuild.pl new file mode 100755 index 0000000..4a33f0f --- /dev/null +++ b/scripts/cvs-debuild.pl @@ -0,0 +1,216 @@ +#!/usr/bin/perl + +# A wrapper for cvs-buildpackage to use debuild, still giving access +# to all of debuild's functionality. + +# Copyright 2003, Julian Gilbey <jdg@debian.org> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +# We will do simple option processing. The calling syntax of this +# program is: +# +# cvs-debuild [<debuild options>] [<cvs-buildpackage options>] +# [--lintian-opts <lintian options>] +# +# cvs-debuild will run cvs-buildpackage, using debuild as the +# package-building program, passing the debuild and lintian options to +# it. For details of these options, and more information on debuild in +# general, refer to debuild(1). + +use 5.006; +use strict; +use warnings; +use FileHandle; +use File::Basename; +use File::Temp qw/ tempfile /; +use Fcntl; + +my $progname = basename($0); + +# Predeclare functions +sub fatal($); + +sub usage { + print <<"EOF"; + $progname [<debuild options>] [<cvs-buildpackage options>] + [--lintian-opts <lintian options>] + to run cvs-buildpackage using debuild as the package building program + + Accepted debuild options, see debuild(1) or debuild --help for more info: + --no-conf, --noconf + --lintian, --no-lintian + --rootcmd=<gain-root-command>, -r<gain-root-command> + --preserve-envvar=<envvar>, -e<envvar> + --set-envvar=<envvar>=<value>, -e<envvar>=<value> + --preserve-env + --check-dirname-level=<value>, --check-dirname-regex=<regex> + -d, -D + + --help display this message + --version show version and copyright information + All cvs-buildpackage options are accepted, as are all lintian options. + + Note that any cvs-buildpackage options (command line or configuration file) + for setting a root command will override any debuild configuration file + options for this. + +Default settings modified by devscripts configuration files: + (no configuration files are read by $progname) +For information on default debuild settings modified by the +configuration files, run: debuild --help +EOF +} + +sub version { + print <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 2003 by Julian Gilbey <jdg\@debian.org>, +all rights reserved. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. +EOF +} + +# First check we can execute cvs-buildpackage +unless (system("command -v cvs-buildpackage >/dev/null 2>&1") == 0) { + fatal "can't run cvs-buildpackage; have you installed it?"; +} + +# We start by parsing the command line to collect debuild and +# lintian options. We stash them away in temporary files, +# which we will pass to debuild. + +my (@debuild_opts, @cvs_opts, @lin_opts); +{ + no locale; + # debuild opts first + while (@ARGV) { + my $arg = shift; + $arg eq '--help' and usage(), exit 0; + $arg eq '--version' and version(), exit 0; + + # rootcmd gets passed on to cvs-buildpackage + if ($arg eq '-r' or $arg eq '--rootcmd') { + push @cvs_opts, '-r' . shift; + next; + } + if ($arg =~ /^(?:-r|--rootcmd=)(.*)$/) { + push @cvs_opts, "-r$1"; + next; + } + + # other debuild options are stashed + if ($arg =~ /^--(no-?conf|(no-?)?lintian)$/) { + push @debuild_opts, $arg; + next; + } + if ($arg =~ /^--preserve-env$/) { + push @debuild_opts, $arg; + next; + } + if ($arg =~ /^--check-dirname-(level|regex)$/) { + push @debuild_opts, $arg, shift; + next; + } + if ($arg =~ /^--check-dirname-(level|regex)=/) { + push @debuild_opts, $arg; + next; + } + if ($arg =~ /^--(preserve|set)-envvar$/) { + push @debuild_opts, $arg, shift; + next; + } + if ($arg =~ /^--(preserve|set)-envvar=/) { + push @debuild_opts, $arg; + next; + } + # dpkg-buildpackage now has a -e option, so we have to be + # careful not to confuse the two; their option will always have + # the form -e<maintainer email> or similar + if ($arg eq '-e') { + push @debuild_opts, $arg, shift; + next; + } + if ($arg =~ /^-e(\w+(=.*)?)$/) { + push @debuild_opts, $arg; + next; + } + if ($arg eq '-d' or $arg eq '-D') { + push @debuild_opts, $arg; + next; + } + # Anything else matching /^-e/ is a dpkg-buildpackage option, + # and we've also now considered all debuild options. + # So now handle cvs-buildpackage options + unshift @ARGV, $arg; + last; + } + + while (@ARGV) { + my $arg = shift; + if ($arg eq '-L' or $arg eq '--lintian') { + fatal "$arg argument not recognised; use --lintian-opts instead"; + } + if ($arg =~ /^--lin(tian|da)-opts$/) { + push @lin_opts, $arg; + last; + } + push @cvs_opts, $arg; + } + + if (@ARGV) { + push @lin_opts, @ARGV; + } +} + +# So we've now got three arrays, and we'll have to store the debuild +# options in temporary files +my $debuild_cmd = 'debuild --cvs-debuild'; +my ($fhdeb, $fhlin); +if (@debuild_opts) { + $fhdeb = tempfile("cvspreXXXXXX", UNLINK => 1) + or fatal "cannot create temporary file: $!"; + fcntl $fhdeb, Fcntl::F_SETFD(), 0 + or fatal "disabling close-on-exec for temporary file: $!"; + print $fhdeb join("\0", @debuild_opts); + $debuild_cmd .= ' --cvs-debuild-deb /dev/fd/' . fileno($fhdeb); +} +if (@lin_opts) { + $fhlin = tempfile("cvspreXXXXXX", UNLINK => 1) + or fatal "cannot create temporary file: $!"; + fcntl $fhlin, Fcntl::F_SETFD(), 0 + or fatal "disabling close-on-exec for temporary file: $!"; + print $fhlin join("\0", @lin_opts); + $debuild_cmd .= ' --cvs-debuild-lin /dev/fd/' . fileno($fhlin); +} + +# Now we can run cvs-buildpackage +my $status = system('cvs-buildpackage', '-C' . $debuild_cmd, @cvs_opts); + +if ($status & 255) { + die "cvs-debuild: cvs-buildpackage terminated abnormally: " + . sprintf("%#x", $status) . "\n"; +} else { + exit($status >> 8); +} + +sub fatal($) { + my ($pack, $file, $line); + ($pack, $file, $line) = caller(); + (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d; + $msg =~ s/\n\n$/\n/; + die $msg; +} diff --git a/scripts/dcmd.1 b/scripts/dcmd.1 new file mode 100644 index 0000000..0438082 --- /dev/null +++ b/scripts/dcmd.1 @@ -0,0 +1,112 @@ +.TH DCMD 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +dcmd \- expand file lists of .dsc/.changes files in the command line +.SH SYNOPSIS +\fBdcmd\fR [\fIoptions\fR] [\fIcommand\fR] [\fIchanges-file\fR|\fIdsc-file\fR] ... +.SH DESCRIPTION +\fBdcmd\fR replaces any reference to a \fI.dsc\fR or \fI.changes\fR file in the +command line with the list of files in its 'Files' section, plus the +file itself. It allows easy manipulation of all the files involved in +an upload (for \fI.changes\fR files) or a source package (for \fI.dsc\fR files). + +If \fIcommand\fR is omitted (that is the first argument is an existing \fI.dsc\fR +or \fI.changes\fR file), the expanded list of files is printed to stdout, one file +by line. Useful for usage in backticks. +.SH OPTIONS +There are a number of options which may be used in order to select only a +subset of the files listed in the \fI.dsc\fR or \fI.changes\fR file. If a requested file +is not found, an error message will be printed. +.TP 14 +.B \-\-dsc +Select the \fI.dsc\fR file. +.TP +.B \-\-schanges +Select \fI.changes\fR files for the 'source' architecture. +.TP +.B \-\-bchanges +Select \fI.changes\fR files for binary architectures. +.TP +.B \-\-changes +Select \fI.changes\fR files. Implies \fB\-\-schanges\fR and \fB\-\-bchanges\fR. +.TP +.B \-\-archdeb +Select architecture-dependent binary packages (\fI.deb\fR files). +.TP +.B \-\-indepdeb +Select architecture-independent binary packages (\fI.deb\fR files). +.TP +.B \-\-deb +Select binary packages (\fI.deb\fR files). Implies \fB\-\-archdeb\fR and \fB\-\-indepdeb\fR. +.TP +.B \-\-archudeb +Select architecture-dependent \fI.udeb\fR binary packages. +.TP +.B \-\-indepudeb +Select architecture-independent \fI.udeb\fR binary packages. +.TP +.B \-\-udeb +Select \fI.udeb\fR binary packages. Implies \fB\-\-archudeb\fR and \fB\-\-indepudeb\fR. +.TP +.BR \-\-tar ,\ \-\-orig +Select the upstream \fI.tar\fR file. +.TP +.BR \-\-diff ,\ \-\-debtar +Select the Debian \fI.debian.tar\fR or \fI.diff\fR file. +.PP +Each option may be prefixed by \fB\-\-no\fR to indicate that all files +\fInot\fR matching the specification should be selected. +.PP +It is not possible to combine positive filtering options (e.g. \fB\-\-dsc\fR) +and negative filtering options (e.g. \fB\-\-no\-changes\fR) in the same +\fBdcmd\fR invocation. +.TP +.B \-\-no\-fail\-on\-missing\fR, \fB\-r +If any of the requested files were not found, do not output an error. +.TP +.B \-\-package\fR, \fB\-p +Output package name part only. +.TP +.B \-\-sort\fR, \fB\-s +Sort output alphabetically. +.TP +.B \-\-tac\fR, \fB\-t +Reverse output order. + +.SH "EXAMPLES" +Copy the result of a build to another machine: + +.nf +$ dcmd scp rcs_5.7-23_amd64.changes elegiac:/tmp +rcs_5.7-23.dsc 100% 490 0.5KB/s 00:00 +rcs_5.7-23.diff.gz 100% 12KB 11.7KB/s 00:00 +rcs_5.7-23_amd64.deb 100% 363KB 362.7KB/s 00:00 +rcs_5.7-23_amd64.changes 100% 1095 1.1KB/s 00:00 +$ + +$ dcmd \-\-diff \-\-deb scp rcs_5.7-23_amd64.changes elegiac:/tmp +rcs_5.7-23.diff.gz 100% 12KB 11.7KB/s 00:00 +rcs_5.7-23_amd64.deb 100% 363KB 362.7KB/s 00:00 +$ +.fi + +Check the contents of a source package: + +.nf +$ dcmd md5sum rcs_5.7-23.dsc +8fd09ea9654cda128f8d5c337d3b8de7 rcs_5.7.orig.tar.gz +f0ceeae96603e823eacba6721a30b5c7 rcs_5.7-23.diff.gz +5241db1e231b1f43ae5514b63d2523f8 rcs_5.7-23.dsc +$ + +$ dcmd \-\-no\-diff md5sum rcs_5.7-23.dsc +8fd09ea9654cda128f8d5c337d3b8de7 rcs_5.7.orig.tar.gz +5241db1e231b1f43ae5514b63d2523f8 rcs_5.7-23.dsc +$ +.fi + +.SH "SEE ALSO" +.BR dpkg-genchanges (1), +.BR dpkg-source (1) +.SH AUTHOR +This program was written by Romain Francoise <rfrancoise@debian.org> and +is released under the GPL, version 2 or later. diff --git a/scripts/dcmd.sh b/scripts/dcmd.sh new file mode 100755 index 0000000..6c731d8 --- /dev/null +++ b/scripts/dcmd.sh @@ -0,0 +1,329 @@ +#!/bin/sh +# +# dcmd: expand file lists of .dsc/.changes files in the command line +# +# Copyright (C) 2008 Romain Francoise <rfrancoise@debian.org> +# Copyright (C) 2008 Christoph Berg <myon@debian.org> +# Copyright (C) 2008 Adam D. Barratt <adsb@debian.org> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +# Usage: +# +# dcmd replaces any reference to a .dsc or .changes file in the command +# line with the list of files in its 'Files' section, plus the +# .dsc/.changes file itself. +# +# $ dcmd sha1sum rcs_5.7-23_amd64.changes +# f61254e2b61e483c0de2fc163321399bbbeb43f1 rcs_5.7-23.dsc +# 7a2b283b4c505d8272a756b230486a9232376771 rcs_5.7-23.diff.gz +# e3bac970a57a6b0b41c28c615f2919c931a6cb68 rcs_5.7-23_amd64.deb +# c531310b18773d943249cfaa8b539a9b6e14b8f4 rcs_5.7-23_amd64.changes +# $ + +PROGNAME=`basename $0` + +version () { + echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is copyright 2008 by Romain Francoise, all rights reserved. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later." +} + +usage() +{ + printf "Usage: %s [options] [command] [dsc or changes file] [...]\n" $PROGNAME +} + +endswith() +{ + case $1 in + *$2) return 0 ;; + *) return 1;; + esac +} + +# Instead of parsing the file completely as the previous Python +# implementation did (using python-debian), let's just select lines +# that look like they might be part of the file list. +RE="^ [0-9a-f]{32} [0-9]+ ((([a-zA-Z0-9_.-]+/)?[a-zA-Z0-9_.-]+|-) ([a-zA-Z]+|-) )?(.*)$" + +maybe_expand() +{ + local dir + local sedre + if [ -e "$1" ] && (endswith "$1" .changes || endswith "$1" .dsc || endswith "$1" .buildinfo); then + # Need to escape whatever separator is being used in sed expression so + # it doesn't prematurely end the s command + dir=$(dirname "$1" | sed 's/,/\\,/g') + if [ "$(echo "$1" | cut -b1-2)" != "./" ]; then + sedre="\." + fi + sed --regexp-extended -n "s,$RE,$dir/\5,p" <"$1" | sed "s,^$sedre/,," + fi +} + +DSC=1; BCHANGES=1; SCHANGES=1; ARCHDEB=1; INDEPDEB=1; TARBALL=1; DIFF=1 +CHANGES=1; DEB=1; ARCHUDEB=1; INDEPUDEB=1; UDEB=1; BUILDINFO=1; +FILTERED=0; FAIL_MISSING=1 +EXTRACT_PACKAGE_NAME=0 +SORT=0 +TAC=0 + +while [ $# -gt 0 ]; do + TYPE="" + case "$1" in + --version|-v) version; exit 0;; + --help|-h) usage; exit 0;; + --no-fail-on-missing|-r) FAIL_MISSING=0;; + --fail-on-missing) FAIL_MISSING=1;; + --package|-p) EXTRACT_PACKAGE_NAME=1;; + --sort|-s) SORT=1;; + --tac|-t) TAC=1;; + --) shift; break;; + --no-*) + TYPE=${1#--no-} + case "$FILTERED" in + 1) echo "$PROGNAME: Can't combine --foo and --no-foo options" >&2; + exit 1;; + 0) FILTERED=-1;; + esac;; + --**) + TYPE=${1#--} + case "$FILTERED" in + -1) echo "$PROGNAME: Can't combine --foo and --no-foo options" >&2; + exit 1;; + 0) FILTERED=1; DSC=0; BCHANGES=0; SCHANGES=0; CHANGES=0 + ARCHDEB=0; INDEPDEB=0; DEB=0; ARCHUDEB=0; INDEPUDEB=0 + UDEB=0; TARBALL=0; DIFF=0; BUILDINFO=0;; + esac;; + *) break;; + esac + + case "$TYPE" in + "") ;; + dsc) [ "$FILTERED" = "1" ] && DSC=1 || DSC=0;; + buildinfo) [ "$FILTERED" = "1" ] && BUILDINFO=1 || BUILDINFO=0;; + changes) [ "$FILTERED" = "1" ] && + { BCHANGES=1; SCHANGES=1; CHANGES=1; } || + { BCHANGES=0; SCHANGES=0; CHANGES=0; } ;; + bchanges) [ "$FILTERED" = "1" ] && BCHANGES=1 || BCHANGES=0;; + schanges) [ "$FILTERED" = "1" ] && SCHANGES=1 || SCHANGES=1;; + deb) [ "$FILTERED" = "1" ] && + { ARCHDEB=1; INDEPDEB=1; DEB=1; } || + { ARCHDEB=0; INDEPDEB=0; DEB=0; };; + archdeb) [ "$FILTERED" = "1" ] && ARCHDEB=1 || ARCHDEB=0;; + indepdeb) [ "$FILTERED" = "1" ] && INDEPDEB=1 || INDEPDEB=0;; + udeb) [ "$FILTERED" = "1" ] && + { ARCHUDEB=1; INDEPUDEB=1; UDEB=1; } || + { ARCHUDEB=0; INDEPUDEB=0; UDEB=0; };; + archudeb) [ "$FILTERED" = "1" ] && ARCHUDEB=1 || ARCHUDEB=0;; + indepudeb) [ "$FILTERED" = "1" ] && INDEPUDEB=1 || INDEPUDEB=0;; + tar|orig) [ "$FILTERED" = "1" ] && TARBALL=1 || TARBALL=0;; + diff|debtar) [ "$FILTERED" = "1" ] && DIFF=1 || DIFF=0;; + *) echo "$PROGNAME: Unknown option '$1'" >&2; exit 1;; + esac + shift +done + +cmd= +args="" +while [ $# -gt 0 ]; do + arg="$1" + shift + temparg="$(maybe_expand "$arg")" + if [ -z "$temparg" ]; then + if [ -z "$cmd" ]; then + cmd="$arg" + continue + fi + # Not expanded, so simply add to argument list + args="$args +$arg" + else + SEEN_INDEPDEB=0; SEEN_ARCHDEB=0; SEEN_SCHANGES=0; SEEN_BCHANGES=0 + SEEN_INDEPUDEB=0; SEEN_ARCHUDEB=0; SEEN_UDEB=0; + SEEN_TARBALL=0; SEEN_DIFF=0; SEEN_DSC=0; SEEN_BUILDINFO=0; + MISSING=0 + newarg="" + # Output those items from the expanded list which were + # requested, and record which files are contained in the list + eval "$(echo "$temparg" | while read THISARG; do + if [ -z "$THISARG" ]; then + # Skip + : + elif endswith "$THISARG" _all.deb; then + [ "$INDEPDEB" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_INDEPDEB=1;" + elif endswith "$THISARG" .deb; then + [ "$ARCHDEB" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_ARCHDEB=1;" + elif endswith "$THISARG" _all.udeb; then + [ "$INDEPUDEB" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_INDEPUDEB=1;" + elif endswith "$THISARG" .udeb; then + [ "$ARCHUDEB" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_ARCHUDEB=1;" + elif endswith "$THISARG" .debian.tar.gz || \ + endswith "$THISARG" .debian.tar.xz || \ + endswith "$THISARG" .debian.tar.bz2; then + [ "$DIFF" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_DIFF=1;" + elif endswith "$THISARG" .tar.bz2 || \ + endswith "$THISARG" .tar.gz || \ + endswith "$THISARG" .tar.lzma || \ + endswith "$THISARG" .tar.xz || \ + endswith "$THISARG" .tar.zst || \ + endswith "$THISARG" .tar.*.asc; then + [ "$TARBALL" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_TARBALL=1;" + elif endswith "$THISARG" _source.changes; then + [ "$SCHANGES" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_SCHANGES=1;" + elif endswith "$THISARG" .changes; then + [ "$BCHANGES" = "0" ] || echo "newarg\"\$newarg +$THISARG\";" + echo "SEEN_BCHANGES=1;" + elif endswith "$THISARG" .dsc; then + [ "$DSC" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_DSC=1;" + elif endswith "$THISARG" .buildinfo; then + [ "$BUILDINFO" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_BUILDINFO=1;" + elif endswith "$THISARG" .diff.gz; then + [ "$DIFF" = "0" ] || echo "newarg=\"\$newarg +$THISARG\";" + echo "SEEN_DIFF=1;" + elif [ "$FILTERED" != "1" ]; then + # What is it? Output anyway + echo "newarg=\"\$newarg +$THISARG\";" + fi + done)" + + INCLUDEARG=1 + if endswith "$arg" _source.changes; then + [ "$SCHANGES" = "1" ] || INCLUDEARG=0 + SEEN_SCHANGES=1 + elif endswith "$arg" .changes; then + [ "$BCHANGES" = "1" ] || INCLUDEARG=0 + SEEN_BCHANGES=1 + elif endswith "$arg" .dsc; then + [ "$DSC" = "1" ] || INCLUDEARG=0 + SEEN_DSC=1 + elif endswith "$arg" .buildinfo; then + [ "$BUILDINFO" = "1" ] || INCLUDEARG=0 + SEEN_BUILDINFO=1 + fi + + if [ "$FAIL_MISSING" = "1" ] && [ "$FILTERED" = "1" ]; then + if [ "$CHANGES" = "1" ]; then + if [ "$SEEN_SCHANGES" = "0" ] && [ "$SEEN_BCHANGES" = "0" ]; then + MISSING=1; echo "$arg: .changes fiie not found" >&2 + fi + else + if [ "$SCHANGES" = "1" ] && [ "$SEEN_SCHANGES" = "0" ]; then + MISSING=1; echo "$arg: source .changes file not found" >&2 + fi + if [ "$BCHANGES" = "1" ] && [ "$SEEN_BCHANGES" = "0" ]; then + MISSING=1; echo "$arg: binary .changes file not found" >&2 + fi + fi + + if [ "$DEB" = "1" ]; then + if [ "$SEEN_INDEPDEB" = "0" ] && [ "$SEEN_ARCHDEB" = "0" ]; then + MISSING=1; echo "$arg: binary packages not found" >&2 + fi + else + if [ "$INDEPDEB" = "1" ] && [ "$SEEN_INDEPDEB" = "0" ]; then + MISSING=1; echo "$arg: arch-indep packages not found" >&2 + fi + if [ "$ARCHDEB" = "1" ] && [ "$SEEN_ARCHDEB" = "0" ]; then + MISSING=1; echo "$arg: arch-dep packages not found" >&2 + fi + fi + + if [ "$UDEB" = "1" ]; then + if [ "$SEEN_INDEPUDEB" = "0" ] && [ "$SEEN_ARCHUDEB" = "0" ]; then + MISSING=1; echo "$arg: udeb packages not found" >&2 + fi + else + if [ "$INDEPUDEB" = "1" ] && [ "$SEEN_INDEPUDEB" = "0" ]; then + MISSING=1; echo "$arg: arch-indep udeb packages not found" >&2 + fi + if [ "$ARCHUDEB" = "1" ] && [ "$SEEN_ARCHUDEB" = "0" ]; then + MISSING=1; echo "$arg: arch-dep udeb packages not found" >&2 + fi + + fi + + if [ "$BUILDINFO" = "1" ] && [ "$SEEN_BUILDINFO" = "0" ]; then + MISSING=1; echo "$arg: .buildinfo file not found" >&2 + fi + if [ "$DSC" = "1" ] && [ "$SEEN_DSC" = "0" ]; then + MISSING=1; echo "$arg: .dsc file not found" >&2 + fi + if [ "$TARBALL" = "1" ] && [ "$SEEN_TARBALL" = "0" ]; then + MISSING=1; echo "$arg: upstream tar not found" >&2 + fi + if [ "$DIFF" = "1" ] && [ "$SEEN_DIFF" = "0" ]; then + MISSING=1; echo "$arg: Debian debian.tar/diff not found" >&2 + fi + + [ "$MISSING" = "0" ] || exit 1 + fi + + args="$args +$newarg" + [ "$INCLUDEARG" = "0" ] || args="$args +$arg" + fi +done + +IFS=' +' +if [ "$EXTRACT_PACKAGE_NAME" = "1" ]; then + packages="" + for arg in $args; do + packages="$packages +$(echo "$arg" |sed s/_.*//)" + done + args="$packages" +fi +if [ "$SORT" = "1" ]; then + args="$(echo "$args"| sort -)" +fi +if [ "$TAC" = "1" ]; then + args="$(echo "$args"| tac -)" +fi +if [ -z "$cmd" ]; then + for arg in $args; do + echo $arg + done + exit 0 +fi + +exec $cmd $args diff --git a/scripts/dd-list.1 b/scripts/dd-list.1 new file mode 100644 index 0000000..61f9231 --- /dev/null +++ b/scripts/dd-list.1 @@ -0,0 +1,110 @@ +.\" Copyright 2005 Lars Wirzenius +.\" +.\" This program 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 of the License, or +.\" (at your option) any later version. +.\" +.\" This program 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 this program. If not, see <https://www.gnu.org/licenses/>. +.\" +.TH DD\-LIST 1 2011-10-27 "Debian" +.\" -------------------------------------------------------------------- +.SH NAME +dd\-list \- nicely list .deb packages and their maintainers +.\" -------------------------------------------------------------------- +.SH SYNOPSIS +.BR dd\-list " [" \-hiusV "] [" \-\-help "] [" \-\-stdin "]" +.BR "" "[" "\-\-sources \fISources_file" "] +.BR "" "[" \-\-dctrl "] [" \-\-version "] [" \-\-uploaders "] [" \fIpackage " ...]" +.\" -------------------------------------------------------------------- +.SH DESCRIPTION +.B dd\-list +produces nicely formatted lists of Debian (.deb) packages and their +maintainers. +.PP +Input is a list of source or binary package names on the command line +(or the standard input if +.B \-\-stdin +is given). +Output is a list of the following format, where package names are source +packages by default: +.PP +.nf +.RS +J. Random Developer <jrandom@debian.org> +.RS +j-random-package +j-random-other +.RE +.PP +Diana Hacker <diana@example.org> +.RS +fun-package +more-fun-package +.RE +.RE +.fi +.PP +This is useful when you want, for example, to produce a list of packages +that need to attention from their maintainers, e.g., to be rebuilt when +a library version transition happens. +.\" -------------------------------------------------------------------- +.SH OPTIONS +.TP +.BR \-h ", " \-\-help +Print brief help message. +.TP +.BR \-i ", " \-\-stdin +Read package names from the standard input, instead of taking them +from the command line. Package names are whitespace delimited. +.TP +.BR \-d ", " \-\-dctrl +Read package list from standard input in the format of a Debian +package control file. This includes the status file, or output of +apt-cache. This is the fastest way to use dd-list, as it uses the +maintainer information from the input instead of looking up the maintainer +of each listed package. +.IP +If no \fISource:\fP line is given, the \fIPackage:\fP name is used for +output, which might be a binary package name. +.TP +.BR \-z ", " \-\-uncompress +Try to uncompress the \-\-dctrl input before parsing. Supported compression +formats are gz, bzip2 or xz. +.TP +\fB\-s\fR, \fB\-\-sources\fR \fISources_file\fR +Read package information from the specified \fISources_file\fRs. This can be +given multiple times. The files can be gz, bzip2 or xz compressed. If the +filename does not end in \fI.gz\fR, \fI.bz2\fR or \fI.xz\fR, then the \fB-z\fR +option must be used. +.IP +If no \fISources_file\fRs are specified, dd\-list will ask apt\-get for +an appropriate set of sources (if \fIapt\fR is at version greater than 1.1.8), +else any files matching \fI/var/lib/apt/lists/*_source_Sources\fR will be used. +.TP +.BR \-u ", " \-\-uploaders +Also list developers who are named as uploaders of packages, not only +the maintainers; this is the default behaviour, use \-\-nouploaders to +prevent it. Uploaders are indicated with "(U)" appended to the package name. +.TP +.BR \-nou ", " \-\-nouploaders +Only list package Maintainers, do not list Uploaders. +.TP +.BR \-b ", " \-\-print\-binary +Use binary package names in the output instead of source package names +(has no effect with \fB--dctrl\fP if the \fIPackage:\fP line contains +source package names). +.TP +.BR \-V ", " \-\-version +Print the version. +.\" -------------------------------------------------------------------- +.SH AUTHOR +Lars Wirzenius <liw@iki.fi> +.P +Joey Hess <joeyh@debian.org> diff --git a/scripts/dd-list.pl b/scripts/dd-list.pl new file mode 100755 index 0000000..d1dbcfb --- /dev/null +++ b/scripts/dd-list.pl @@ -0,0 +1,322 @@ +#!/usr/bin/perl +# +# dd-list: Generate a list of maintainers of packages. +# +# Written by Joey Hess <joeyh@debian.org> +# Modifications by James McCoy <jamessan@debian.org> +# Based on a python implementation by Lars Wirzenius. +# Copyright 2005 Lars Wirzenius, Joey Hess +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +use strict; +use warnings; +use FileHandle; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use Dpkg::Version; +use Dpkg::IPC; + +my $uncompress; + +BEGIN { + $uncompress = eval { + require IO::Uncompress::AnyUncompress; + IO::Uncompress::AnyUncompress->import('$AnyUncompressError'); + 1; + }; +} + +my $version = '###VERSION###'; + +sub normalize_package { + my $name = shift; + # Remove any arch-qualifier + $name =~ s/:.*//; + return lc($name); +} + +sub sort_developers { + return map { $_->[0] } + sort { $a->[1] cmp $b->[1] } + map { [$_, uc] } @_; +} + +sub help { + print <<"EOF"; +Usage: dd-list [options] [package ...] + + -h, --help + Print this help text. + + -i, --stdin + Read package names from the standard input. + + -d, --dctrl + Read package list in Debian control data from standard input. + + -z, --uncompress + Try to uncompress the --dctrl input before parsing. Supported + compression formats are gz, bzip2 and xz. + + -s, --sources SOURCES_FILE + Read package information from given SOURCES_FILE instead of all files + matching /var/lib/apt/lists/*_source_Sources. Can be specified + multiple times. The files can be gz, bzip2 or xz compressed. + + -u, --uploaders + Also list Uploaders of packages, not only the listed Maintainers + (this is the default behaviour, use --nouploaders to prevent this). + + -nou, --nouploaders + Only list package Maintainers, do not list Uploaders. + + -b, --print-binary + If binary package names are given as input, print these names + in the output instead of corresponding source packages. + + -V, --version + Print version (it\'s $version by the way). +EOF +} + +my $use_stdin = 0; +my $use_dctrl = 0; +my $source_files = []; +my $show_uploaders = 1; +my $opt_uncompress = 0; +my $print_binary = 0; +GetOptions( + "help|h" => sub { help(); exit }, + "stdin|i" => \$use_stdin, + "dctrl|d" => \$use_dctrl, + "sources|s=s@" => \$source_files, + "uploaders|u!" => \$show_uploaders, + 'z|uncompress' => \$opt_uncompress, + "print-binary|b" => \$print_binary, + "version" => sub { print "dd-list version $version\n" }) + or do { + help(); + exit(1); + }; + +if ($opt_uncompress && !$uncompress) { + warn +"You must have the libio-compress-perl package installed to use the -z option.\n"; + exit 1; +} + +my %dict; +my $errors = 0; +my %package_name; + +sub parsefh { + my ($fh, $fname, $check_package) = @_; + local $/ = "\n\n"; + my $package_names; + if ($check_package) { + $package_names = sprintf '(?:^| )(%s)(?:,|$)', + join '|', map { "\Q$_\E" } + keys %package_name; + } + my %sources; + while (<$fh>) { + my ($package, $source, $binaries, $maintainer, @uploaders); + + # These source packages are only kept around because of stale binaries + # on old archs or due to Built-Using relationships. + if (/^Extra-Source-Only:\s+yes/m) { + next; + } + + # Binary is shown in _source_Sources and contains all binaries produced by + # that source package + if (/^Binary:\s+(.*(?:\n .*)*)$/m) { + $binaries = $1; + $binaries =~ s/\n//; + } + # Package is shown both in _source_Sources and _binary-*. It is the + # name of the package, source or binary respectively, being described + # in that control stanza + if (/^Package:\s+(.*)$/m) { + $package = $1; + } + # Source is shown in _binary-* and specifies the source package which + # produced the binary being described + if (/^Source:\s+(.*)$/m) { + $source = $1; + } + if (/^Maintainer:\s+(.*)$/m) { + $maintainer = $1; + } + if (/^Uploaders:\s+(.*(?:\n .*)*)$/m) { + my $matches = $1; + $matches =~ s/\n//g; + @uploaders = split /(?<=>)\s*,\s*/, $matches; + } + my $version = '0~0~0'; + if (/^Version:\s+(.*)$/m) { + $version = $1; + } + + if (defined $maintainer + && (defined $package || defined $source || defined $binaries)) { + $source ||= $package; + $binaries ||= $package; + my @names; + if ($check_package) { + my @pkgs; + if (@pkgs = ($binaries =~ m/$package_names/g)) { + $sources{$source}{$version}{binaries} = [@pkgs]; + } elsif ($source !~ m/$package_names/) { + next; + } + } else { + $sources{$source}{$version}{binaries} = [$binaries]; + } + $sources{$source}{$version}{maintainer} = $maintainer; + $sources{$source}{$version}{uploaders} = [@uploaders]; + } else { + warn "E: parse error in stanza $. of $fname\n"; + $errors = 1; + } + } + + for my $source (keys %sources) { + my @versions + = sort map { Dpkg::Version->new($_) } keys %{ $sources{$source} }; + my $version = $versions[-1]; + my $srcinfo = $sources{$source}{$version}; + my @names; + if ($check_package) { + $package_name{$source}--; + $package_name{$_}-- for @{ $srcinfo->{binaries} }; + } + @names = $print_binary ? @{ $srcinfo->{binaries} } : $source; + push @{ $dict{ $srcinfo->{maintainer} } }, @names; + if ($show_uploaders && @{ $srcinfo->{uploaders} }) { + foreach my $uploader (@{ $srcinfo->{uploaders} }) { + push @{ $dict{$uploader} }, map "$_ (U)", @names; + } + } + } +} + +if ($use_dctrl) { + my $fh; + if ($uncompress) { + $fh = IO::Uncompress::AnyUncompress->new('-') + or die "E: Unable to decompress STDIN: $AnyUncompressError\n"; + } else { + $fh = \*STDIN; + } + parsefh($fh, 'STDIN'); +} else { + my @packages; + if ($use_stdin) { + while (my $line = <STDIN>) { + chomp $line; + $line =~ s/^\s+|\s+$//g; + push @packages, split(' ', $line); + } + } else { + @packages = @ARGV; + } + for my $name (@packages) { + $package_name{ normalize_package($name) } = 1; + } + + my $apt_version; + spawn( + exec => ['dpkg-query', '-W', '-f', '${source:Version}', 'apt'], + to_string => \$apt_version, + wait_child => 1, + nocheck => 1 + ); + + my $useAptHelper = 0; + if (defined $apt_version) { + $useAptHelper + = version_compare_relation($apt_version, REL_GE, '1.1.8'); + } + + unless (@{$source_files}) { + if ($useAptHelper) { + my ($sources, $err); + spawn( + exec => [ + 'apt-get', 'indextargets', + '--format', '$(FILENAME)', + 'Created-By: Sources' + ], + to_string => \$sources, + error_to_string => \$err, + wait_child => 1, + nocheck => 1 + ); + if ($? >> 8) { + die "Unable to get list of Sources files from apt: $err\n"; + } + + $source_files = [split(/\n/, $sources)]; + } else { + $source_files = [glob('/var/lib/apt/lists/*_source_Sources')]; + } + } + + foreach my $source (@{$source_files}) { + my $fh; + if ($useAptHelper) { + my $good = open($fh, '-|', '/usr/lib/apt/apt-helper', 'cat-file', + $source); + if (!$good) { + warn +"E: Couldn't run apt-helper to get contents of '$source': $!\n"; + $errors = 1; + next; + } + } else { + if ($opt_uncompress + || ($uncompress && $source =~ m/\.(?:gz|bz2|xz)$/)) { + $fh = IO::Uncompress::AnyUncompress->new($source); + } else { + $fh = FileHandle->new("<$source"); + } + unless (defined $fh) { + warn "E: Couldn't open $source\n"; + $errors = 1; + next; + } + } + parsefh($fh, $source, 1); + close $fh; + } +} + +foreach my $developer (sort_developers(keys %dict)) { + print "$developer\n"; + my %seen; + foreach my $package (sort @{ $dict{$developer} }) { + next if $seen{$package}; + $seen{$package} = 1; + print " $package\n"; + } + print "\n"; +} + +foreach my $package (grep { $package_name{$_} > 0 } keys %package_name) { + warn "E: Unknown package: $package\n"; + $errors = 1; +} + +exit($errors); diff --git a/scripts/deb-reversion.dbk b/scripts/deb-reversion.dbk new file mode 100644 index 0000000..942f4e9 --- /dev/null +++ b/scripts/deb-reversion.dbk @@ -0,0 +1,320 @@ +<?xml version='1.0' encoding='ISO-8859-1'?> +<!DOCTYPE refentry PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN" +"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [ + +<!-- + +Process this file with an XSLT processor: `xsltproc \ +-''-nonet /usr/share/sgml/docbook/stylesheet/xsl/nwalsh/\ +manpages/docbook.xsl manpage.dbk'. A manual page +<package>.<section> will be generated. You may view the +manual page with: nroff -man <package>.<section> | less'. A +typical entry in a Makefile or Makefile.am is: + +DB2MAN=/usr/share/sgml/docbook/stylesheet/xsl/nwalsh/\ +manpages/docbook.xsl +XP=xsltproc -''-nonet + +manpage.1: manpage.dbk + $(XP) $(DB2MAN) $< + +The xsltproc binary is found in the xsltproc package. The +XSL files are in docbook-xsl. Please remember that if you +create the nroff version in one of the debian/rules file +targets (such as build), you will need to include xsltproc +and docbook-xsl in your Build-Depends control field. + +--> + + <!-- Fill in your name for FIRSTNAME and SURNAME. --> + <!ENTITY dhfirstname "<firstname>martin f.</firstname>"> + <!ENTITY dhsurname "<surname>krafft</surname>"> + <!ENTITY dhmaintfirstname "<firstname>Julian</firstname>"> + <!ENTITY dhmaintsurname "<surname>Gilbey</surname>"> + <!-- Please adjust the date whenever revising the manpage. --> + <!ENTITY dhdate "<date>Feb 13, 2006</date>"> + <!-- SECTION should be 1-8, maybe w/ subsection other parameters are + allowed: see man(7), man(1). --> + <!ENTITY dhsection "<manvolnum>1</manvolnum>"> + <!ENTITY dhemail "<email>madduck@debian.org</email>"> + <!ENTITY dhmaintemail "<email>jdg@debian.org</email>"> + <!ENTITY dhusername "martin f. krafft"> + <!ENTITY dhmaintusername "Julian Gilbey"> + <!ENTITY dhucpackage "<refentrytitle>deb-reversion</refentrytitle>"> + <!ENTITY dhpackage "deb-reversion"> + <!ENTITY dhcommand "deb-reversion"> + + <!ENTITY debian "<productname>Debian</productname>"> + <!ENTITY gnu "<acronym>GNU</acronym>"> + <!ENTITY gpl "&gnu; <acronym>GPL</acronym>"> +]> + +<refentry> + <refentryinfo> + <address> + &dhemail; + </address> + &dhdate; + </refentryinfo> + <refmeta> + &dhucpackage; + + &dhsection; + </refmeta> + <refnamediv> + <refname>&dhcommand;</refname> + + <refpurpose>simple script to change the version of a .deb file</refpurpose> + </refnamediv> + + <refsynopsisdiv> + <cmdsynopsis> + <command>&dhcommand;</command> + <arg choice="opt"> + <replaceable>options</replaceable> + </arg> + <replaceable> .deb-file</replaceable> + <arg choice="opt" rep="repeat"><replaceable>log message</replaceable></arg> + </cmdsynopsis> + </refsynopsisdiv> + + <refsect1> + <title>DESCRIPTION + + + &dhcommand; unpacks the specified .deb file, changes the version + number in the relevant locations, appends a Debian + changelog entry with the specified + contents, and creates a new .deb file with the updated version. + + + + By default, the tool creates a new version number suitable for + local changes, such that the new package will be greater than + the current one, but lesser than any future, official Debian + packages. With , the version + number can be specified directly. On the other hand, the + simply calculates the new version number but + does not generate a new package. + + + + When building a .deb file, root privileges are required in order + to have the correct permissions and ownerships in the resulting + .deb file. This can be achieved either by running + &dhcommand; as root or running under + fakeroot + 1, as 'fakeroot + &dhcommand; foo.deb'. + + + + With , a hook script may + be specified, which is run on the unpacked binary packages just + before it is repacked. If you want to write changelog entries + from within the hook, use 'dch -a -- your message'. + (Alternatively, do not give a changelog entry on the + &dhcommand; command line and + dch will be called automatically.) The hook + command must be placed in quotes if it has more than one word; + it is called via sh -c. + + + + + OPTIONS + + + new-version + new-version + + + Specifies the version number to be used for the new + version. Passed to + dch + 1 + . + + + + + + old-version + old-version + + + Specifies the version number to be used as the old + version instead of the version stored in the .deb's + control file. + + + + + + + + + + Only calculate and display the new version number which + would be used; do not build a new .deb file. Cannot be + used in conjunction with . + + + + + + string + string + + + Instead of using 'LOCAL.' as the version string to append + to the old version number, use string instead. + + + + + + hook-command + hook-command + + + A hook command to run after unpacking the old .deb file and + modifying the changelog, and before packing up the new .deb + file. Must be in quotes if it is more than one (shell) + word. Only one hook command may be specified; if you want + to perform more than this, you could specify 'bash' as the + hook command, and you will then be given a shell to work + in. + + + + + + + + + + Pass to + + dpkg-deb + 1 + . + + + + + + + + + + Pass to + + dch + 1 + + + + + + + + + + + Display usage information. + + + + + + + + + + Display version information. + + + + + + + + SEE ALSO + + + dch + 1 + , + + dpkg-deb + 1 + , + + fakeroot + 1 + + + + + + DISCLAIMER + + &dhpackage; is a tool intended to help porters with + modifying packages for other architectures, and to augment deb-repack, + which creates modified packages with identical version numbers as the + official packages. Chaos will ensue! With &dhpackage;, a proper version + number can be selected, which does not obstruct the next official + release but can be specifically pinned with APT or held with dpkg. + + + + Please take note that &dhpackage; does not come without problems. While + it works fine in most cases, it may just not in yours. Especially, + please consider that it changes binary packages (only!) and hence can + break strict versioned dependencies between binary packages generated + from the same source. + + + You are using this tool at your own risk and I shall not shed a tear if + your gerbil goes up in flames, your microwave attacks the stereo, or the + angry slamming of your fist spills your coffee into the keyboard, which + sets off a chain reaction resulting in a vast amount of money transferred + from your account to mine. + + + + + AUTHOR + + + &dhpackage; is Copyright 2004-5 by &dhusername; &dhemail; and + modifications are Copyright 2006 by &dhmaintusername; &dhmaintemail;. + + + + Permission is granted to copy, distribute and/or modify this document + under the terms of the Artistic License: + http://www.opensource.org/licenses/artistic-license.php. + On Debian systems, the complete text of the Artistic License can be + found + in /usr/share/common-licenses/Artistic. + + + + This manual page was written by &dhusername; &dhemail; and + modified by &dhmaintusername; &dhmaintemail;. + + + + + + diff --git a/scripts/deb-reversion.sh b/scripts/deb-reversion.sh new file mode 100755 index 0000000..d9c2c89 --- /dev/null +++ b/scripts/deb-reversion.sh @@ -0,0 +1,240 @@ +#!/bin/bash +# +# deb-reversion -- a script to bump a .deb file's version number. +# +# Copyright © martin f. krafft +# with contributions by: Goswin von Brederlow, Filippo Giunchedi +# Released under the terms of the Artistic License 2.0 +# +# TODO: +# - add debugging output. +# - allow to be used on dpkg-source and dpkg-deb unpacked source packages. +# +set -eu + +PROGNAME=${0##*/} +PROGVERSION=0.9.1 +VERSTR='LOCAL.' + +versioninfo() { + echo "$PROGNAME $PROGVERSION" + echo "$PROGNAME is copyright © martin f. krafft" + echo "Released under the terms of the Artistic License 2.0" + echo "This programme is part of devscripts ###VERSION###." +} + +usage() +{ + cat <<-_eousage + Usage: $PROGNAME [options] .deb-file [log message] + $PROGNAME -o -c + + Increase the .deb file's version number, noting the change in the + changelog with the specified log message. You should run this + program either as root or under fakeroot. + + Options: + _eousage + cat <<-_eooptions | column -s\& -t + -v ver|--new-version=ver & use this as new version number + -o old|--old-version=ver & calculate new version number based on this old one + -c|--calculate-only & only calculate (and print) the augmented version + -s str|--string=str & append this string instead of '$VERSTR' to + & calculate new version number + -k script|--hook=script & call this script before repacking + -D|--debug & call dpkg-deb in debug mode + -b|--force-bad-version & passed through to dch + -h|--help & show this output + -V|--version & show version information + _eooptions +} + +write() +{ + local PREFIX; PREFIX="$1"; shift + echo "${PREFIX}: $PROGNAME: $@" >&2 +} + +err() +{ + write E "$@" +} + +CURDIR="$(pwd)" +SHORTOPTS=hVo:v:ck:Ds:b +LONGOPTS=help,version,old-version:,new-version:,calculate-only,hook:,debug,string:,force-bad-version +eval set -- "$(getopt -s bash -o $SHORTOPTS -l $LONGOPTS -n $PROGNAME -- "$@")" + +CALCULATE=0 +DPKGDEB_DEBUG= +DEB= +DCH_OPTIONS= +for opt in "$@"; do + case "${OPT_STATE:-}" in + SET_OLD_VERSION) OLD_VERSION="$opt";; + SET_NEW_VERSION) NEW_VERSION="$opt";; + SET_STRING) VERSTR="$opt";; + SET_HOOK) HOOK="$opt";; + *) :;; + esac + [ -n "${OPT_STATE:-}" ] && unset OPT_STATE && continue + + case $opt in + -v|--new-version) OPT_STATE=SET_NEW_VERSION;; + -o|--old-version) OPT_STATE=SET_OLD_VERSION;; + -c|--calculate-only|--print-only) CALCULATE=1;; + -s|--string) OPT_STATE=SET_STRING;; + -k|--hook) OPT_STATE=SET_HOOK;; + -D|--debug) DPKGDEB_DEBUG=--debug;; + -b|--force-bad-version) DCH_OPTIONS="${DCH_OPTIONS} -b";; + -h|--help) usage; exit 0;; + -V|--version) versioninfo; exit 0;; + --) :;; + *) + if [ -f "$opt" ]; then + if [ -n "$DEB" ]; then + err "multiple .deb files specified: ${DEB##*/} and $opt" + exit 1 + else + case "$opt" in + /*.deb|/*.udeb) DEB="$opt";; + *.deb| *.udeb) DEB="${CURDIR}/$opt";; + *) + err "not a .deb file: $opt"; + exit 2 + ;; + esac + fi + else + LOG="${LOG:+$LOG }$opt" + fi + ;; + esac +done + +if [ $CALCULATE -eq 0 ] || [ -z "${OLD_VERSION:-}" ]; then + if [ -z "$DEB" ]; then + err no .deb file specified. + exit 3 + fi +fi + +if [ -n "${NEW_VERSION:-}" ] && [ $CALCULATE -eq 1 ]; then + echo "$PROGNAME error: the options -v and -c cannot be used together" >&2 + usage + exit 4 +fi + +make_temp_dir() +{ + TMPDIR=$(mktemp -d --tmpdir deb-reversion.XXXXXX) + trap 'rm -rf "$TMPDIR"' EXIT + mkdir -p ${TMPDIR}/package + TMPDIR=${TMPDIR}/package +} + +extract_deb_file() +{ + dpkg-deb $DPKGDEB_DEBUG --extract $1 . + dpkg-deb $DPKGDEB_DEBUG --control $1 DEBIAN +} + +get_version() +{ + dpkg --info $1 | sed -ne 's,^[[:space:]]Version: ,,p' +} + +bump_version() +{ + case "$1" in + *${VERSTR}[0-9]*) + REV=${1##*${VERSTR}} + echo ${1%${VERSTR}*}${VERSTR}$((++REV));; + *-*) + echo ${1}${VERSTR}1;; + *) + echo ${1}-0${VERSTR}1;; + esac +} + +call_hook() +{ + [ -z "${HOOK:-}" ] && return 0 + export VERSION + sh -c "$HOOK" +} + +change_version() +{ + PACKAGE=$(sed -ne 's,^Package: ,,p' DEBIAN/control) + VERSION=$1 + + # changelog massaging is only needed in the deb (not-udeb) case: + if [ "$DEB_TYPE" = "deb" ]; then + LOGFILE= + for i in changelog{,.Debian}.gz; do + [ -f usr/share/doc/${PACKAGE}/$i ] \ + && LOGFILE=usr/share/doc/${PACKAGE}/$i + done + [ -z "$LOGFILE" ] && { echo "changelog file not found"; return 1; } + mkdir -p debian + zcat "$LOGFILE" > debian/changelog + shift + dch $DCH_OPTIONS -v "$VERSION" -- "$@" + call_hook + gzip -9 -c debian/changelog >| "$LOGFILE" + MD5SUM=$(md5sum "$LOGFILE") + sed -i "s@^[^ ]* $LOGFILE\$@$MD5SUM@" DEBIAN/md5sums + else + call_hook + fi + + sed -i -e "s,^Version: .*,Version: $VERSION," DEBIAN/control + rm -rf debian +} + +repack_file() +{ + cd .. + dpkg-deb -b package >/dev/null + debfile=$(dpkg-name package.deb | sed -e "s,.*['\`]\(.*\).,\1,") + # if Package-Type: udeb is absent, dpkg-name can't rename into *.udeb, + # so we're left to an extra rename afterwards: + if [ "$DEB_TYPE" = udeb ]; then + udebfile=${debfile%%.deb}.udeb + mv $debfile $udebfile + echo $udebfile + else + echo $debfile + fi +} + +[ -z "${OLD_VERSION:-}" ] && OLD_VERSION="$(get_version $DEB)" +[ -z "${NEW_VERSION:-}" ] && NEW_VERSION="$(bump_version $OLD_VERSION)" + +if [ $CALCULATE -eq 1 ]; then + echo $NEW_VERSION + exit 0 +fi + +if [ $(id -u) -ne 0 ]; then + err need root rights. + exit 5 +fi + +make_temp_dir +cd "$TMPDIR" + +DEB_TYPE=$(echo "$DEB"|sed 's/.*[.]//') +extract_deb_file "$DEB" +change_version "$NEW_VERSION" "${LOG:-Bumped version with $PROGNAME}" +FILE="$(repack_file)" + +if [ -f "$CURDIR/$FILE" ]; then + echo "$CURDIR/$FILE exists, moving to $CURDIR/$FILE.orig ." >&2 + mv -i "$CURDIR/$FILE" "$CURDIR/$FILE.orig" +fi + +mv "../$FILE" "$CURDIR" + +echo "version $VERSION of $PACKAGE is now available in $FILE ." >&2 diff --git a/scripts/deb-why-removed.pl b/scripts/deb-why-removed.pl new file mode 100755 index 0000000..ba6635f --- /dev/null +++ b/scripts/deb-why-removed.pl @@ -0,0 +1,251 @@ +#!/usr/bin/perl +# +# Copyright © 2017-2019 Guillem Jover +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +use strict; +use warnings; + +use File::Basename; +use File::Path qw(make_path); +use File::Copy qw(cp); +use File::Spec; +use Getopt::Long qw(:config posix_default no_ignorecase); +use HTTP::Tiny; +use Dpkg::Index; +use Devscripts::Output; + +my $VERSION = '0.0'; +my ($PROGNAME) = $0 =~ m{(?:.*/)?([^/]*)}; + +my %url_map = ('debian' => 'https://ftp-master.debian.org/removals-full.822'); +my $default_url_origin = 'debian'; + +# +# Functions +# + +sub version { + print "$PROGNAME $VERSION (devscripts ###VERSION###)\n"; +} + +sub usage { + print <...] ... + +Options: + -u, --url URL URL to the removals deb822 file list (defaults to + <$url_map{$default_url_origin}>). + --no-refresh Do not refresh the cached removals file even if old. + -h, -?, --help Print this help text. + --version Print the version. +HELP +} + +# XXX: DAK produces broken output, fix it up here before we process it. +# +# The two current bogus instances are, at least two fused paragraphs, and +# bogus "sh: 0: getcwd() failed: No such file or directory" command output +# interpersed within the file. +sub fixup_broken_metadata { + my $cachefile = shift; + my $para_sep = 1; + + open my $fh_old, '<', $cachefile + or ds_error("cannot open cache file $cachefile for fixup"); + open my $fh_new, '>', "$cachefile.new" + or ds_error("cannot open cache file $cachefile.new for fixup"); + while (my $line = <$fh_old>) { + if ($line =~ m/^\s*$/) { + $para_sep = 1; + } elsif (not $para_sep and $line =~ m/^Date:/) { + # XXX: We assume each paragraph starts with a Date: field, and + # inject the missing newline. + print {$fh_new} "\n"; + } else { + $para_sep = 0; + } + + # XXX: Fixup shell output detritus. + if ($line =~ s/sh: 0: getcwd\(\) failed: No such file or directory//) { + # Remove the trailing line so that the next line gets folded back + # into this one. + chomp $line; + } + + print {$fh_new} $line; + } + close $fh_new or ds_error("cannot write cache file $cachefile.new"); + close $fh_old; + + # Preserve the original mtime so that mirroring works. + my ($atime, $mtime) = (stat $cachefile)[8, 9]; + utime $atime, $mtime, "$cachefile.new"; + + rename "$cachefile.new", $cachefile + or ds_error("cannot replace cache file with fixup version"); +} + +sub cache_file { + my ($url, $cachefile) = @_; + + cp($url, $cachefile) or ds_error("cannot copy removal metadata: $!"); + fixup_broken_metadata($cachefile); +} + +sub cache_http { + my ($url, $cachefile) = @_; + + my $http = HTTP::Tiny->new(verify_SSL => 1); + my $resp = $http->mirror($url, $cachefile); + + unless ($resp->{success}) { + ds_error( + "cannot fetch removal metadata: $resp->{status} $resp->{reason}"); + } + + if ($resp->{status} != 304) { + fixup_broken_metadata($cachefile); + } +} + +# +# Main program +# + +my $opts; + +GetOptions( + 'url|u=s' => \$opts->{'url'}, + 'no-refresh' => \$opts->{'no-refresh'}, + 'help|h|?' => sub { usage(); exit 0 }, + 'version' => sub { version(); exit 0 }, + ) + or die "\nUsage: $PROGNAME [ + +This directory contains the cached removal files downloaded from the archive. +I will be either B<$XDG_CACHE_HOME> or if that is not defined +B<$HOME/.cache/>. + +=back + +=head1 SEE ALSO + +L + +=cut diff --git a/scripts/debbisect b/scripts/debbisect new file mode 100755 index 0000000..0434e0f --- /dev/null +++ b/scripts/debbisect @@ -0,0 +1,1143 @@ +#!/usr/bin/env python3 +# +# Copyright 2020 Johannes Schauer Marin Rodrigues +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. + +# snapshot.d.o API feature requests: +# +# Currently, the API does not allow to list all dates for which a snapshot +# was made. This would be useful to allow skipping snapshots. Currently we +# blindly bisect but without knowing which date on snapshot.d.o a given +# timestamp resolves to, we cannot mark it as untestable (see feature request +# above) and without a list of testable timestamps we cannot reliably test +# a timestamp before and after the one to skip. +# See also: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=969603 +# +# It would be useful to know when a package version was first seen in a given +# suite. Without this knowledge we cannot reliably pick the snapshot timestamps +# at which we want to test a given suite. For example, a package version might +# appear in experimental long before it appears in unstable or any other suite +# that is to be tested. Thus, the first_seen attribute of the snapshot API is +# not very useful to determine a limited set of timestamps to test. +# See also: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=806329 + +# wishlist features +# ----------------- +# +# - restrict set of tested snapshot timestamps to those where a given package +# set actually changed (needs a resolution to #806329) +# +# - allow marking snapshot timestamps as skippable, for example via script +# exit code (needs resolution to #969603) +# +# - add convenience function which builds a given source package and installs +# its build dependencies automatically + +# complains about log_message cannot be fixed because the original function +# names one of its arguments "format" which is also forbidden... +# pylint: disable=W0221 +# +# pylint complains about too many branches but the code would not become more +# readable by spreading it out across more functions +# pylint: disable=R0912 +# +# allow more than 1000 lines in this file +# pylint: disable=C0302 + +import argparse +import collections +import email.utils +import http.server +import http.client +from http import HTTPStatus +import logging +import math +import os +import re +import shutil +import socketserver +import subprocess +import sys +import tempfile +import threading +import urllib.error +import urllib.request +import io +import lzma +from datetime import datetime, timedelta, timezone +from functools import partial +import time +import atexit +import debian +import debian.deb822 +import requests + +have_dateutil = True +try: + import dateutil.parser +except ImportError: + have_dateutil = False + +have_parsedatetime = True +try: + import parsedatetime +except ImportError: + have_parsedatetime = False + +DINSTALLRATE = 21600 + + +# We utilize the fact that the HTTP interface of snapshot.d.o responds with a +# HTTP 301 redirect to the corresponding timestamp. +# It would be better if there as an officially documented API function: +# http://bugs.debian.org/969605 +def sanitize_timestamp(timestamp): + conn = http.client.HTTPConnection("snapshot.debian.org") + conn.request( + "HEAD", "/archive/debian/" + timestamp.strftime("%Y%m%dT%H%M%SZ") + "/" + ) + res = conn.getresponse() + if res.status == 200: + return timestamp + assert res.status == 301 + prefix = "http://snapshot.debian.org/archive/debian/" + location = res.headers["Location"] + assert location.startswith(prefix) + # flake8 wrongly insists that there must be no whitespace before colon + # See https://github.com/PyCQA/pycodestyle/issues/373 + location = location[len(prefix) :] # noqa: E203 + return datetime.strptime(location, "%Y%m%dT%H%M%S%z/") + + +# we use a http proxy for two reasons +# 1. it allows us to cache package data locally which is useful even for +# single runs because temporally close snapshot timestamps share packages +# and thus we reduce the load on snapshot.d.o which is also useful because +# 2. snapshot.d.o requires manual bandwidth throttling or else it will cut +# our TCP connection. Instead of using Acquire::http::Dl-Limit as an apt +# option we use a proxy to only throttle on the initial download and then +# serve the data with full speed once we have it locally +class Proxy(http.server.SimpleHTTPRequestHandler): + def do_GET(self): + # check validity and extract the timestamp + try: + c1, c2, c3, timestamp, _ = self.path.split("/", 4) + except ValueError: + logging.error("don't know how to handle this request: %s", self.path) + self.send_error(HTTPStatus.BAD_REQUEST, "Bad request path (%s)" % self.path) + return + if ["", "archive", "debian"] != [c1, c2, c3]: + logging.error("don't know how to handle this request: %s", self.path) + self.send_error(HTTPStatus.BAD_REQUEST, "Bad request path (%s)" % self.path) + return + # make sure the pool directory is symlinked to the global pool + linkname = os.path.join(self.directory, c2, c3, timestamp, "pool") + if not os.path.exists(linkname): + os.makedirs(os.path.join(self.directory, c2, c3, timestamp), exist_ok=True) + os.symlink("../../../pool", linkname) + path = os.path.abspath(self.translate_path(self.path)) + if not os.path.exists(path): + self._download_new(path) + return + f = self.send_head() + if f: + try: + self.copyfile(f, self.wfile) + except ConnectionResetError: + pass + f.close() + + def _download_new(self, path): + # save file in local cache + maxtries = 3 + head, _ = os.path.split(path) + os.makedirs(head, exist_ok=True) + totalsize = -1 + downloaded = 0 + for trynum in range(maxtries): + try: + headers = {} + if downloaded > 0: + # if file was partly downloaded, only request the rest + headers["Range"] = "bytes=%d-" % downloaded + req = urllib.request.Request( + "http://snapshot.debian.org/" + self.path, headers=headers + ) + # we use os.fdopen(os.open(...)) because we don't want to + # truncate the file and seek to the right position but also + # create it if it doesn't exist yet + with urllib.request.urlopen(req) as f, os.fdopen( + os.open(path, os.O_RDWR | os.O_CREAT), "rb+" + ) as out: + out.seek(downloaded) + if trynum == 0: + self.send_response(HTTPStatus.OK) + self.send_header("Content-type", f.headers["Content-type"]) + self.send_header("Content-Length", f.headers["Content-Length"]) + self.send_header("Last-Modified", f.headers["Last-Modified"]) + self.end_headers() + totalsize = int(f.headers["Content-Length"]) + while downloaded < totalsize: + chunksize = 800 * 1024 + if totalsize - downloaded < chunksize: + chunksize = totalsize - downloaded + buf = f.read(chunksize) # 800 kB/s + if len(buf) != chunksize: + # something went wrong + logging.warning( + "%s: wanted %d but got %d bytes (try %d of %d)", + path, + chunksize, + len(buf), + trynum + 1, + maxtries, + ) + time.sleep(10) + break + time.sleep(1) # snapshot.d.o needs heavy throttling + out.write(buf) + self.wfile.write(buf) + downloaded += chunksize + except urllib.error.HTTPError as e: + if e.code == 404: + self.send_error(404, "URLError") + return + logging.warning("got urllib.error.HTTPError: %s %s", repr(e), self.path) + except urllib.error.URLError as e: + logging.warning("got urllib.error.URLError: %s", repr(e)) + if downloaded == totalsize: + break + if totalsize != downloaded: + if os.path.exists(path): + os.unlink(path) + self.send_error(500, "URLError") + return + + def log_message(self, fmt, *args): + pass + + +def srcpkgversions_by_timestamp(srcpkgname, timestamp, suite): + versions = set() + r = requests.get( + "http://snapshot.debian.org/archive/debian/%s/dists/%s/main/source/Sources.xz" + % (timestamp.strftime("%Y%m%dT%H%M%SZ"), suite) + ) + data = lzma.decompress(r.content) + for src in debian.deb822.Sources.iter_paragraphs(io.BytesIO(data)): + if src["Package"] != srcpkgname: + continue + versions.add(debian.debian_support.Version(src["Version"])) + return versions + + +def binpkgversion_by_timestamp(binpkgname, timestamp, suite, architecture): + r = requests.get( + "http://snapshot.debian.org/archive/debian/%s/dists/%s/main/binary-%s/Packages.xz" + % (timestamp.strftime("%Y%m%dT%H%M%SZ"), suite, architecture) + ) + data = lzma.decompress(r.content) + for pkg in debian.deb822.Packages.iter_paragraphs(io.BytesIO(data)): + if pkg["Package"] == binpkgname: + return debian.debian_support.Version(pkg["Version"]) + return None + + +# This function does something similar to what this wiki page describes +# https://wiki.debian.org/BisectDebian#Finding_dates_for_specific_packages +# +# The problem with the approach on that wiki page as well as the one below in +# Python is, that it relies on the first_seen entry provided by snapshot.d.o. +# This means that we do not know when a package first appeared in a given +# suite. It could've first appeared in experimental or even in Debian Ports. +# +# Also see: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=806329 +def first_seen_by_pkg(packages, timestamp_begin, timestamp_end, suite, architecture): + timestamps = set() + for pkg in packages: + logging.info("obtaining versions for %s", pkg) + if pkg.startswith("src:"): + pkg = pkg[4:] + oldest_versions = srcpkgversions_by_timestamp(pkg, timestamp_begin, suite) + if len(oldest_versions) == 0: + logging.error( + "source package %s cannot be found in good timestamp", pkg + ) + sys.exit(1) + elif len(oldest_versions) == 1: + oldest_version = oldest_versions.pop() + else: + oldest_version = min(oldest_versions) + newest_versions = srcpkgversions_by_timestamp(pkg, timestamp_end, suite) + if len(newest_versions) == 0: + logging.error("source package %s cannot be found in bad timestamp", pkg) + sys.exit(1) + elif len(newest_versions) == 1: + newest_version = newest_versions.pop() + else: + newest_version = max(newest_versions) + + for result in requests.get( + "http://snapshot.debian.org/mr/package/%s/" % pkg + ).json()["result"]: + if debian.debian_support.Version(result["version"]) < oldest_version: + continue + if debian.debian_support.Version(result["version"]) > newest_version: + continue + r = requests.get( + "http://snapshot.debian.org/mr/package/%s/%s/allfiles?fileinfo=1" + % (pkg, result["version"]) + ) + logging.info("retrieving for: %s", result["version"]) + for fileinfo in [ + fileinfo + for fileinfos in r.json()["fileinfo"].values() + for fileinfo in fileinfos + ]: + if fileinfo["archive_name"] != "debian": + continue + timestamps.add( + datetime.strptime(fileinfo["first_seen"], "%Y%m%dT%H%M%S%z") + ) + else: + oldest_version = binpkgversion_by_timestamp( + pkg, timestamp_begin, suite, architecture + ) + if oldest_version is None: + logging.error( + "binary package %s cannot be found in good timestamp", pkg + ) + sys.exit(1) + newest_version = binpkgversion_by_timestamp( + pkg, timestamp_end, suite, architecture + ) + if newest_version is None: + logging.error("binary package %s cannot be found in bad timestamp", pkg) + sys.exit(1) + r = requests.get("http://snapshot.debian.org/mr/binary/%s/" % pkg) + for result in r.json()["result"]: + if debian.debian_support.Version(result["version"]) < oldest_version: + continue + if debian.debian_support.Version(result["version"]) > newest_version: + continue + r = requests.get( + "http://snapshot.debian.org/mr/binary/%s/%s/binfiles?fileinfo=1" + % (pkg, result["version"]) + ) + logging.info("retrieving for: %s", result["version"]) + hashes = [ + e["hash"] + for e in r.json()["result"] + if e["architecture"] == architecture + ] + for fileinfo in [ + fileinfo for h in hashes for fileinfo in r.json()["fileinfo"][h] + ]: + if fileinfo["archive_name"] != "debian": + continue + timestamps.add( + datetime.strptime(fileinfo["first_seen"], "%Y%m%dT%H%M%S%z") + ) + return timestamps + + +def get_mirror(port, timestamp): + if port is not None: + return "http://%s:%d/archive/debian/%s" % ( + "127.0.0.1", + port, + timestamp.strftime("%Y%m%dT%H%M%SZ"), + ) + return "http://snapshot.debian.org/archive/debian/%s" % timestamp.strftime( + "%Y%m%dT%H%M%SZ" + ) + + +def runtest(timestamp, staticargs, toupgrade=None, badtimestamp=None): + ret = 0 + goodmirror = get_mirror(staticargs.port, timestamp) + env = { + "DEBIAN_BISECT_EPOCH": "%d" % int(timestamp.timestamp()), + "DEBIAN_BISECT_TIMESTAMP": timestamp.strftime("%Y%m%dT%H%M%SZ"), + "PATH": os.environ.get("PATH", "/usr/sbin:/usr/bin:/sbin:/bin"), + } + if staticargs.port is not None: + env["DEBIAN_BISECT_MIRROR"] = goodmirror + if staticargs.depends or staticargs.qemu: + scriptname = "run_bisect" + if staticargs.qemu: + scriptname = "run_bisect_qemu" + # first try run_bisect.sh from the directory where debbisect lives in + # case we run this from a git clone + run_bisect = os.path.join( + os.path.dirname(os.path.realpath(__file__)), scriptname + ".sh" + ) + if not os.path.exists(run_bisect): + run_bisect = os.path.join("/usr/share/devscripts/scripts/", scriptname) + cmd = [ + run_bisect, + staticargs.depends, + staticargs.script, + goodmirror, + staticargs.architecture, + staticargs.suite, + staticargs.components, + ] + if staticargs.qemu: + cmd.extend([staticargs.qemu["memsize"], staticargs.qemu["disksize"]]) + if toupgrade: + cmd.extend([get_mirror(staticargs.port, badtimestamp), toupgrade]) + else: + # execute it directly if it's an executable file or if it there are no + # shell metacharacters + if ( + os.access(staticargs.script, os.X_OK) + or re.search(r"[^\w@\%+=:,.\/-]", staticargs.script, re.ASCII) is None + ): + cmd = [staticargs.script] + else: + cmd = ["sh", "-c", staticargs.script] + output = b"" + try: + # we only use the more complex Popen method if live output is required + # for logging levels of INFO or lower + if logging.root.isEnabledFor(logging.INFO): + process = subprocess.Popen( + cmd, stderr=subprocess.STDOUT, stdout=subprocess.PIPE, env=env + ) + buf = io.BytesIO() + for line in iter(process.stdout.readline, b""): + sys.stdout.buffer.write(line) + sys.stdout.buffer.flush() + buf.write(line) + ret = process.wait() + output = buf.getvalue() + else: + output = subprocess.check_output(cmd, stderr=subprocess.STDOUT, env=env) + except subprocess.CalledProcessError as e: + ret = e.returncode + output = e.output + return (ret, output) + + +def get_log_fname(timestamp, goodbad, toupgrade=None): + if toupgrade is None: + return "debbisect.%s.log.%s" % (timestamp.strftime("%Y%m%dT%H%M%SZ"), goodbad) + return "debbisect.%s.%s.log.%s" % ( + timestamp.strftime("%Y%m%dT%H%M%SZ"), + toupgrade, + goodbad, + ) + + +def write_log_symlink(goodbad, output, timestamp, toupgrade=None): + fname = get_log_fname(timestamp, goodbad, toupgrade) + with open(fname, "wb") as f: + f.write(output) + if goodbad == "good": + if os.path.lexists("debbisect.log.good"): + os.unlink("debbisect.log.good") + os.symlink(fname, "debbisect.log.good") + elif goodbad == "bad": + if os.path.lexists("debbisect.log.bad"): + os.unlink("debbisect.log.bad") + os.symlink(fname, "debbisect.log.bad") + + +def bisect(good, bad, staticargs): + # no idea how to split this function into parts without making it + # unreadable + # pylint: disable=too-many-statements + diff = bad - good + print("snapshot timestamp difference: %f days" % (diff / timedelta(days=1))) + + stepnum = 1 + starttime = datetime.now(timezone.utc) + + steps = round( + (math.log(diff.total_seconds()) - math.log(DINSTALLRATE)) / math.log(2) + 2 + ) + print("approximately %d steps left to test" % steps) + # verify that the good timestamp is really good and the bad timestamp is really bad + # we try the bad timestamp first to make sure that the problem exists + if os.path.exists(get_log_fname(good, "good")): + print( + "#%d: using cached results from %s" % (stepnum, get_log_fname(good, "good")) + ) + else: + print("#%d: trying known good %s..." % (stepnum, good)) + ret, output = runtest(good, staticargs) + if ret != 0: + write_log_symlink("bad", output, good) + print( + "good timestamp was actually bad -- see debbisect.log.bad for details" + ) + return None + write_log_symlink("good", output, good) + stepnum += 1 + steps = round( + (math.log(diff.total_seconds()) - math.log(DINSTALLRATE)) / math.log(2) + 1 + ) + timeleft = steps * (datetime.now(timezone.utc) - starttime) / (stepnum - 1) + print("computation time left: %s" % timeleft) + print("approximately %d steps left to test" % steps) + if os.path.exists(get_log_fname(bad, "bad")): + print( + "#%d: using cached results from %s" % (stepnum, get_log_fname(bad, "bad")) + ) + else: + print("#%d: trying known bad %s..." % (stepnum, bad)) + ret, output = runtest(bad, staticargs) + if ret == 0: + write_log_symlink("good", output, bad) + print( + "bad timestamp was actually good -- see debbisect.log.good for details" + ) + return None + write_log_symlink("bad", output, bad) + stepnum += 1 + + while True: + diff = bad - good + # One may be tempted to try and optimize this step by finding all the + # packages that differ between the two timestamps and then finding + # all the snapshot timestamps where the involved packages changed + # in their version. But since dependencies can arbitrarily change + # between two given timestamps, drawing in more packages or requiring + # less packages, the only reliable method is really to strictly bisect + # by taking the timestamp exactly between the two and not involve + # other guessing magic. + newts = sanitize_timestamp(good + diff / 2) + if newts in [good, bad]: + # If the middle timestamp mapped onto good or bad, then the + # timestamps are very close to each other. Test if there is maybe + # not another one between them by sanitizing the timestamp one + # second before the bad one + newts = sanitize_timestamp(bad - timedelta(seconds=1)) + if newts == good: + break + print("snapshot timestamp difference: %f days" % (diff / timedelta(days=1))) + steps = round( + (math.log(diff.total_seconds()) - math.log(DINSTALLRATE)) / math.log(2) + 0 + ) + timeleft = steps * (datetime.now(timezone.utc) - starttime) / (stepnum - 1) + print("computation time left: %s" % timeleft) + print("approximately %d steps left to test" % steps) + if os.path.exists(get_log_fname(newts, "good")): + print( + "#%d: using cached result (was good) from %s" + % (stepnum, get_log_fname(newts, "good")) + ) + good = newts + elif os.path.exists(get_log_fname(newts, "bad")): + print( + "#%d: using cached result (was bad) from %s" + % (stepnum, get_log_fname(newts, "bad")) + ) + bad = newts + else: + print("#%d: trying %s..." % (stepnum, newts)) + ret, output = runtest(newts, staticargs) + if ret == 0: + print("test script output: good") + write_log_symlink("good", output, newts) + good = newts + else: + print("test script output: bad") + write_log_symlink("bad", output, newts) + bad = newts + stepnum += 1 + return good, bad + + +def datetimestr(val): + # since py3 we don't need pytz to figure out the local timezone + localtz = datetime.now(timezone.utc).astimezone().tzinfo + + # first trying known formats + for fmt in [ + "%Y%m%dT%H%M%SZ", # snapshot.debian.org style + # ISO 8601 + "%Y-%m-%d", + "%Y-%m-%dT%H:%M", + "%Y-%m-%dT%H:%M:%S", + "%Y-%m-%dT%H:%M:%S%z", + ]: + try: + dt = datetime.strptime(val, fmt) + except ValueError: + continue + else: + # if we don't know the timezone, assume the local one + if dt.tzinfo is None: + dt = dt.replace(tzinfo=localtz) + return dt + + # try parsing the debian/changelog datetime format as specified by RFC 2822 + # we cannot use strptime() because that honors the locale and RFC + # 2822 requires that day and month names be the English abbreviations. + try: + dt = email.utils.parsedate_to_datetime(val) + except TypeError: + pass + else: + return dt + + # next, try parsing using dateutil.parser + if have_dateutil: + try: + dt = dateutil.parser.parse(val) + except ValueError: + pass + else: + # if we don't know the timezone, assume the local one + if dt.tzinfo is None: + dt = dt.replace(tzinfo=localtz) + return dt + + # if that didn't work, try freeform formats + if have_parsedatetime: + cal = parsedatetime.Calendar() + dt, ret = cal.parseDT(val) + if ret != 0: + # if we don't know the timezone, assume the local one + if dt.tzinfo is None: + dt = dt.replace(tzinfo=localtz) + return dt + + if not have_dateutil: + logging.info("parsing date failed -- maybe install python3-dateutil") + if not have_parsedatetime: + logging.info("parsing date failed -- maybe install python3-parsedatetime") + + # all failed, we cannot parse this + raise argparse.ArgumentTypeError("not a valid datetime: %s" % val) + + +def qemuarg(val): + defaultmem = "1G" + defaultdisk = "4G" + ret = {"memsize": defaultmem, "disksize": defaultdisk} + for keyval in val.split(","): + # we use startswith() so that "defaults" can also be abbreviated (even + # down to the empty string) + if "defaults".startswith(keyval): + ret["memsize"] = defaultmem + ret["disksize"] = defaultdisk + continue + try: + key, val = keyval.split("=", maxsplit=1) + except ValueError as e: + raise argparse.ArgumentTypeError("no key=val pair: %s" % keyval) from e + if key not in ["memsize", "disksize"]: + raise argparse.ArgumentTypeError("unknown key: %s" % key) + if not re.fullmatch(r"\d+((k|K|M|G|T|P|E|Z|Y)(iB|B)?)?", val): + raise argparse.ArgumentTypeError("cannot parse size value: %s" % val) + ret[key] = val + return ret + + +def read_pkglist(infile): + result = dict() + with open(infile) as f: + for line in f: + pkg, version = line.split("\t") + result[pkg] = version.strip() + return result + + +def upgrade_single_package(toupgrade, goodpkgs, badpkgs, good, bad, staticargs): + if toupgrade in goodpkgs: + print( + "test upgrading %s %s -> %s..." + % (toupgrade, goodpkgs[toupgrade], badpkgs[toupgrade]) + ) + else: + print("test installing %s %s..." % (toupgrade, badpkgs[toupgrade])) + newbadpkgpath = "./debbisect.%s.%s.pkglist" % ( + good.strftime("%Y%m%dT%H%M%SZ"), + toupgrade, + ) + if os.path.exists(newbadpkgpath) and os.path.exists( + get_log_fname(good, "good", toupgrade) + ): + print( + "using cached result (was good) from %s" + % get_log_fname(good, "good", toupgrade) + ) + if toupgrade in goodpkgs: + print(" upgrading %s does not cause the problem" % toupgrade) + else: + print(" installing %s does not cause the problem" % toupgrade) + return + if os.path.exists(newbadpkgpath) and os.path.exists( + get_log_fname(good, "bad", toupgrade) + ): + print( + "using cached result (was bad) from %s" + % get_log_fname(good, "bad", toupgrade) + ) + print(" upgrading %s triggered the problem" % toupgrade) + else: + ret, output = runtest(good, staticargs, toupgrade, bad) + if ret == 0: + write_log_symlink("good", output, good, toupgrade) + if toupgrade in goodpkgs: + print(" upgrading %s does not cause the problem" % toupgrade) + else: + print(" installing %s does not cause the problem" % toupgrade) + return + write_log_symlink("bad", output, good, toupgrade) + print(" upgrading %s triggered the problem" % toupgrade) + # this package introduced the regression check if more than + # just the package in question got upgraded + newbadpkgs = read_pkglist(newbadpkgpath) + # find all packages that are completely new or of a + # different version than those in the last good test + newupgraded = list() + for pkg, version in newbadpkgs.items(): + if pkg not in goodpkgs or version != goodpkgs[pkg]: + newupgraded.append(pkg) + if not newupgraded: + logging.error("no difference -- this should never happen") + sys.exit(1) + elif len(newupgraded) == 1: + # the only upgraded package should be the one that was + # requested to be upgraded + assert newupgraded[0] == toupgrade + else: + print(" additional packages that got upgraded/installed at the same time:") + for newtoupgrade in newupgraded: + if newtoupgrade == toupgrade: + continue + print( + " %s %s -> %s" + % ( + newtoupgrade, + goodpkgs.get(newtoupgrade, "(n.a.)"), + newbadpkgs[newtoupgrade], + ) + ) + + +def parseargs(): + parser = argparse.ArgumentParser( + formatter_class=argparse.RawDescriptionHelpFormatter, + description="""\ + +Execute a script or a shell snippet for a known good timestamp and a known bad +timestamp and then bisect the timestamps until a timestamp from +snapshot.debian.org is found where the script first fails. Environment +variables are used to tell the script which timestamp to test. See ENVIRONMENT +VARIABLES below. At the end of the execution, the files debbisect.log.good and +debbisect.log.bad are the log files of the last good and last bad run, +respectively. By default, a temporary caching mirror is executed to reduce +bandwidth usage on snapshot.debian.org. If you plan to run debbisect multiple +times on a similar range of timestamps, consider setting a non-temporary cache +directory with the --cache option. + +The program has three basic modes of operation. In the first, the given script +is responsible to set up everything as needed: + + $ {progname} "last week" today script.sh + $ diff -u debbisect.log.good debbisect.log.bad + +If also the --depends option is given, then a chroot of the correct timestamp +will be created each time and the script will receive as first argument the +path to that chroot. Additionally, this mode allows debbisect to figure out the +exact package that was responsible for the failure instead of only presenting +you the last good and first bad timestamp. + +Lastly, you can also provide the --qemu option. In this mode, your test will be +create a qemu virtual machine of the correct timestamp each time. The script +will receive the correct ssh config to log into a host named qemu and execute +arbitrary commands. + +""".format( + progname=sys.argv[0] + ), + epilog="""\ + +*EXAMPLES* + +Just run "do_something" which runs the test and returns a non-zero exit on +failure. + + $ {progname} "last week" today "mmdebstrap --customize-hook='chroot """.format( + progname=sys.argv[0] + ) + + """\\"\\$1\\" do_something' unstable - \\$DEBIAN_BISECT_MIRROR >/dev/null" + $ diff -u debbisect.log.good debbisect.log.bad + +Since the command can easily become very long and quoting very involved, lets +instead use a script: + + $ cat << END > script.sh + > #!/bin/sh + > set -exu + > mmdebstrap \\ + > --verbose \\ + > --aptopt='Acquire::Check-Valid-Until "false"' \\ + > --variant=apt \\ + > --include=pkga,pkgb,pkgc \\ + > --customize-hook='chroot "$1" dpkg -l' \\ + > --customize-hook='chroot "$1" do_something' \\ + > unstable \\ + > - \\ + > $DEBIAN_BISECT_MIRROR \\ + > >/dev/null + > END + $ chmod +x script.sh + $ {progname} --verbose --cache=./cache "two years ago" yesterday ./script.sh + $ diff -u debbisect.log.good debbisect.log.bad + $ rm -r ./cache + +This example sets Acquire::Check-Valid-Until to not fail on snapshot timestamps +from "two years ago", uses the "apt" variant (only Essential:yes plus apt), +installs the packages required for the test using --include, runs "dpkg -l" so +that we can see which packages differed in the logs at the end and uses +--cache=cache so that the apt cache does not get discarded at the end and the +command can be re-run without downloading everything from snapshot.debian.org +again. + +Once debbisect has finished bisecting and figured out the last good and the +first bad timestamp, there might be more than one package that differs in +version between these two timestamps. debbisect can figure out which package is +the culprit if you hand it control over installing dependencies for you via the +--depends option. With that option active, the script will not be responsible +to set up a chroot itself but is given the path to an existing chroot as the +first argument. Here is a real example that verifies the package responsible +for Debian bug #912935: + + $ {progname} --depends=botch "2018-11-17" """.format( + progname=sys.argv[0] + ) + + """"2018-11-22" 'chroot "$1" botch-dose2html --packages=/dev/null --help' + [...] + test upgrading python3-minimal 3.6.7-1 -> 3.7.1-2... + upgrading python3-minimal triggered the problem + +If you want to run above test under qemu, then you would run: + + $ {progname} --depends=botch --qemu=defaults "2018-11-17" """.format( + progname=sys.argv[0] + ) + + """"2018-11-22" 'ssh -F "$1" qemu botch-dose2html --packages=/dev/null --help' + +In the last two examples we omitted the --cache argument for brevity. But +please make use of it to reduce the load on snapshot.debian.org. + +*TIMESTAMPS* + +Valid good and bad timestamp formats are either: + + > the format used by snapshot.debian.org + > ISO 8601 (with or without time, seconds and timezone) + > RFC 2822 (used in debian/changelog) + > all formats understood by the Python dateutil module (if installed) + > all formats understood by the Python parsedatetime module (if installed) + +Without specifying the timezone explicitly, the local offset is used. + +Examples (corresponding to the items in above list, respectively): + + > 20200313T065326Z + > 2020-03-13T06:53:26+00:00 + > Fri, 29 Nov 2019 14:00:08 +0100 + > 5:50 A.M. on June 13, 1990 + > two weeks ago + +*ENVIRONMENT VARIABLES* + +The following environment variables are available to the test script: + +DEBIAN_BISECT_MIRROR Contains the caching mirror address. + +DEBIAN_BISECT_EPOCH Contains an integer representing the unix epoch of the + current timestamp. The value of this variable can + directly be assigned to SOURCE_DATE_EPOCH. + +DEBIAN_BISECT_TIMESTAMP Contains a timestamp in the format used by + snapshot.debian.org. Can also be generated from + DEBIAN_BISECT_EPOCH via: + date --utc --date=@$DEBIAN_BISECT_EPOCH +%Y%m%dT%H%M%SZ + +Written by Johannes Schauer Marin Rodrigues +""", + ) + parser.add_argument( + "-d", + "--debug", + help="Print lots of debugging statements", + action="store_const", + dest="loglevel", + const=logging.DEBUG, + default=logging.WARNING, + ) + parser.add_argument( + "-v", + "--verbose", + help="Be verbose", + action="store_const", + dest="loglevel", + const=logging.INFO, + ) + parser.add_argument( + "--cache", help="cache directory -- by default $TMPDIR is used", type=str + ) + parser.add_argument("--nocache", help="disable cache", action="store_true") + parser.add_argument( + "--port", + help="manually choose port number for the apt cache instead of " + + "automatically choosing a free port", + type=int, + default=0, + ) + parser.add_argument( + "--depends", + help="Comma separated list of binary packages the test script " + + "requires. With this option, the test script will run inside a " + + "chroot with the requested packages installed.", + type=str, + ) + parser.add_argument( + "--qemu", + help="Create qemu virtual machine and pass a ssh config file to the " + + "test script. This argument takes a comma-separated series of " + + "key=value pairs to specify the virtual machine memory size (via " + + "memsize) and the virtual machine disksize (via disksize). Sizes " + + "are measured in bytes or with common unit suffixes like M or G. " + + "To pick the default values (disksize=4G,memsize=1G) the shorthand " + + "'defaults' can be passed.", + type=qemuarg, + ) + parser.add_argument( + "--architecture", + help="Chosen architecture when creating the chroot with --depends or " + + "--qemu (default: native architecture)", + default=subprocess.check_output(["dpkg", "--print-architecture"]).rstrip(), + type=str, + ) + parser.add_argument( + "--suite", + help="Chosen suite when creating the chroot with --depends or --qemu " + + "(default: unstable)", + default="unstable", + type=str, + ) + parser.add_argument( + "--components", + help="Chosen components (separated by comma or whitespace) when " + + "creating the chroot with --depends or --qemu (default: main)", + default="main", + type=str, + ) + parser.add_argument( + "--no-find-exact-package", + help="Normally, when the --depends argument is given so that " + + "debbisect takes care of managing dependencies, the precise package " + + "that introduced the problem is determined after bisection by " + + "installing the packages that differ between the last good and " + + "first bad timestamp one by one. This option disables this feature.", + action="store_true", + ) + parser.add_argument( + "good", + type=datetimestr, + help="good timestamp -- see section TIMESTAMPS for valid formats", + ) + parser.add_argument( + "bad", + type=datetimestr, + help="bad timestamp -- see section TIMESTAMPS for valid formats", + ) + parser.add_argument( + "script", + type=str, + help="test script -- can either be a shell code snippet or an " + + "executable script. A non zero exit code indicates failure. " + + "When also --depends is used, then the first argument to the " + + "script will be the chroot directory. When --qemu is used, then " + + "the first argument to the script will an ssh config for a host " + + "named qemu.", + ) + return parser.parse_args() + + +def setupcache(cache, port): + if cache: + cachedir = cache + else: + cachedir = tempfile.mkdtemp(prefix="debbisect") + logging.info("using cache directory: %s", cachedir) + os.makedirs(cachedir + "/pool", exist_ok=True) + httpd = socketserver.TCPServer( + # the default address family for socketserver is AF_INET so we + # explicitly bind to ipv4 localhost + ("127.0.0.1", port), + partial(Proxy, directory=cachedir), + # to avoid "Address already in use" when the port is specified + # manually, we set socket.SO_REUSEADDR + # to do so, we must set allow_reuse_address and then bind and + # activate manually + bind_and_activate=False, + ) + # this sets socket.SO_REUSEADDR + httpd.allow_reuse_address = True + httpd.server_bind() + httpd.server_activate() + # run server in a new thread + server_thread = threading.Thread(target=httpd.serve_forever) + server_thread.daemon = True + # start thread + server_thread.start() + # retrieve port (in case it was generated automatically) + _, port = httpd.server_address + + def teardown(): + httpd.shutdown() + httpd.server_close() + server_thread.join() + if not cache: + # this should be a temporary directory but lets still be super + # careful + if os.path.exists(cachedir + "/pool"): + shutil.rmtree(cachedir + "/pool") + if os.path.exists(cachedir + "/archive"): + shutil.rmtree(cachedir + "/archive") + os.rmdir(cachedir) + + return port, teardown + + +def find_exact_package(good, bad, staticargs, depends, no_find_exact_package): + goodpkglist = "./debbisect.%s.pkglist" % good.strftime("%Y%m%dT%H%M%SZ") + if not os.path.exists(goodpkglist): + logging.error("%s doesn't exist", goodpkglist) + sys.exit(1) + badpkglist = "./debbisect.%s.pkglist" % bad.strftime("%Y%m%dT%H%M%SZ") + if not os.path.exists(badpkglist): + logging.error("%s doesn't exist", badpkglist) + sys.exit(1) + + # Create a set of packages for which either the version in the last good + # and first bad run differs or which only exist in the first bad run. + goodpkgs = read_pkglist(goodpkglist) + badpkgs = read_pkglist(badpkglist) + upgraded = set() + for pkg, version in goodpkgs.items(): + if pkg in badpkgs and version != badpkgs[pkg]: + upgraded.add(pkg) + for pkg, version in badpkgs.items(): + if pkg not in goodpkgs or version != goodpkgs[pkg]: + upgraded.add(pkg) + upgraded = list(sorted(upgraded)) + if not upgraded: + logging.error("no difference -- this should never happen") + sys.exit(1) + elif len(upgraded) == 1: + print( + "only one package differs: %s %s -> %s" + % ( + upgraded[0], + goodpkgs.get(upgraded[0], "(n.a.)"), + badpkgs[upgraded[0]], + ) + ) + else: + print( + "the following packages differ between the last good and " + + "first bad timestamp:" + ) + for toupgrade in upgraded: + print( + " %s %s -> %s" + % (toupgrade, goodpkgs.get(toupgrade, "(n.a.)"), badpkgs[toupgrade]) + ) + + # if debbisect was tasked with handling dependencies itself, try to + # figure out the exact package that introduce the break + if depends and not no_find_exact_package: + for toupgrade in upgraded: + upgrade_single_package( + toupgrade, goodpkgs, badpkgs, good, bad, staticargs + ) + + +def main(): + args = parseargs() + + logging.basicConfig(level=args.loglevel) + + good = sanitize_timestamp(args.good) + if good != args.good: + print( + "good timestamp %s was remapped to snapshot.d.o timestamp %s" + % (args.good, good) + ) + bad = sanitize_timestamp(args.bad) + if bad != args.bad: + print( + "bad timestamp %s was remapped to snapshot.d.o timestamp %s" + % (args.bad, bad) + ) + + if good > bad: + print("good is later than bad") + sys.exit(1) + + port = None + if not args.nocache: + port, teardown = setupcache(args.cache, args.port) + atexit.register(teardown) + + staticargs = collections.namedtuple( + "args", + ["script", "port", "depends", "architecture", "suite", "components", "qemu"], + ) + staticargs.port = port + for a in ["script", "depends", "architecture", "suite", "components", "qemu"]: + setattr(staticargs, a, getattr(args, a)) + if good == bad: + # test only single timestamp + print("testing single timestamp") + if os.path.exists(get_log_fname(good, "good")): + print( + "using cached result (was good) from %s" % get_log_fname(good, "good") + ) + ret = 0 + elif os.path.exists(get_log_fname(good, "bad")): + print("using cached result (was bad) from %s" % get_log_fname(good, "bad")) + ret = 1 + else: + ret, output = runtest(good, staticargs) + if ret == 0: + print("test script output: good") + write_log_symlink("good", output, good) + else: + print("test script output: bad") + write_log_symlink("bad", output, good) + sys.exit(ret) + res = bisect(good, bad, staticargs) + if res is not None: + good, bad = res + print("bisection finished successfully") + print(" last good timestamp: %s" % good) + print(" first bad timestamp: %s" % bad) + + find_exact_package( + good, bad, staticargs, args.depends, args.no_find_exact_package + ) + + +if __name__ == "__main__": + main() diff --git a/scripts/debc.1 b/scripts/debc.1 new file mode 100644 index 0000000..b043ee5 --- /dev/null +++ b/scripts/debc.1 @@ -0,0 +1,131 @@ +.TH DEBC 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debc \- view contents of a generated Debian package +.SH SYNOPSIS +\fBdebc\fP [\fIoptions\fR] [\fIchanges file\fR] [\fIpackage\fR ...] +.SH DESCRIPTION +\fBdebc\fR figures out the current version of a package and displays +information about the \fI.deb\fR and \fI.udeb\fR files which have been generated +in the current build process. If a \fI.changes\fR file is specified +on the command line, the filename must end with \fI.changes\fR, as +this is how the program distinguishes it from package names. If not, +then \fBdebc\fR has to be called from within the source code directory +tree. In this case, it will look for the \fI.changes\fR file +corresponding to the current package version (by determining the name +and version number from the changelog, and the architecture in the +same way as \fBdpkg-buildpackage\fR(1) does). It then runs +\fBdpkg-deb \-I\fR and \fBdpkg-deb \-c\fR on every \fI.deb\fR and +\fI.udeb\fR archive listed in the \fI.changes\fR file to display +information about the contents of the \fI.deb\fR / \fI.udeb\fR files. +It precedes every \fI.deb\fR or \fI.udeb\fR file with the name of the +file. It assumes that all of the \fI.deb\fR / \fI.udeb\fR archives +live in the same directory as the \fI.changes\fR file. It is +useful for ensuring that the expected files have ended up in the +Debian package. +.PP +If a list of packages is given on the command line, then only those +debs or udebs with names in this list of packages will be processed. +.SH "Directory name checking" +In common with several other scripts in the \fBdevscripts\fR package, +\fBdebc\fR will climb the directory tree until it finds a +\fIdebian/changelog\fR file. As a safeguard against stray files +causing potential problems, it will examine the name of the parent +directory once it finds the \fIdebian/changelog\fR file, and check +that the directory name corresponds to the package name. Precisely +how it does this is controlled by two configuration file variables +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR and \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR, and +their corresponding command-line options \fB\-\-check-dirname-level\fR +and \fB\-\-check-dirname-regex\fR. +.PP +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR can take the following values: +.TP +.B 0 +Never check the directory name. +.TP +.B 1 +Only check the directory name if we have had to change directory in +our search for \fIdebian/changelog\fR. This is the default behaviour. +.TP +.B 2 +Always check the directory name. +.PP +The directory name is checked by testing whether the current directory +name (as determined by \fBpwd\fR(1)) matches the regex given by the +configuration file option \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR or by the +command line option \fB\-\-check-dirname-regex\fR \fIregex\fR. Here +\fIregex\fR is a Perl regex (see \fBperlre\fR(3perl)), which will be +anchored at the beginning and the end. If \fIregex\fR contains a '/', +then it must match the full directory path. If not, then it must +match the full directory name. If \fIregex\fR contains the string +\'PACKAGE', this will be replaced by the source package name, as +determined from the changelog. The default value for the regex is: +\'PACKAGE(-.+)?', thus matching directory names such as PACKAGE and +PACKAGE-version. +.SH OPTIONS +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. +.TP +\fB\-\-debs\-dir\fR \fIdirectory\fR +Look for the \fI.changes\fR, \fI.deb\fR and \fI.udeb\fR files in +\fIdirectory\fR instead of the parent of the source directory. +This should either be an absolute path or relative to the top of the +source directory. +.TP +\fB\-\-check-dirname-level\fR \fIN\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-check-dirname-regex\fR \fIregex\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-list-changes\fR +List the filename of the .changes file, and do not display anything else. This +option only makes sense if a .changes file is NOT passed explicitly in the +command line. This can be used for example in a script that needs to reference +the .changes file, without having to duplicate the heuristics for finding it +that debc already implements. +.TP +\fB\-\-list-debs\fR +List the filenames of the .deb packages, and do not display their contents. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +\fB\-\-help\fR, \fB\-\-version\fR +Show help message and version information respectively. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced in that order to set configuration +variables. Command line options can be used to override configuration +file settings. Environment variable settings are ignored for this +purpose. The currently recognised variables are: +.TP +.B DEBRELEASE_DEBS_DIR +This specifies the directory in which to look for the \fI.changes\fR, +\fI.deb\fR and \fI.udeb\fR files, and is either an absolute path or +relative to the top of the source tree. This corresponds to the +\fB\-\-debs\-dir\fR command line option. This directive could be +used, for example, if you always use \fBpbuilder\fR or +\fBsvn-buildpackage\fR to build your packages. Note that it also +affects \fBdebrelease\fR(1) in the same way, hence the strange name of +the option. +.TP +.BR DEVSCRIPTS_CHECK_DIRNAME_LEVEL ", " DEVSCRIPTS_CHECK_DIRNAME_REGEX +See the above section \fBDirectory name checking\fR for an explanation of +these variables. Note that these are package-wide configuration +variables, and will therefore affect all \fBdevscripts\fR scripts +which check their value, as described in their respective manpages and +in \fBdevscripts.conf\fR(5). +.SH "SEE ALSO" +.BR debdiff (1), +.BR dpkg-deb (1), +.BR devscripts.conf (5) +.SH AUTHOR +Julian Gilbey , based on an original script by +Christoph Lameter . diff --git a/scripts/debc.pl b/scripts/debc.pl new file mode 120000 index 0000000..1a1d45b --- /dev/null +++ b/scripts/debc.pl @@ -0,0 +1 @@ +debi.pl \ No newline at end of file diff --git a/scripts/debchange.1 b/scripts/debchange.1 new file mode 100644 index 0000000..752a450 --- /dev/null +++ b/scripts/debchange.1 @@ -0,0 +1,491 @@ +.TH DEBCHANGE 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debchange \- Tool for maintenance of the debian/changelog file in a source package +.SH SYNOPSIS +\fBdebchange\fR [\fIoptions\fR] [\fItext\fR ...] +.br +\fBdch\fR [\fIoptions\fR] [\fItext\fR ...] +.SH DESCRIPTION +\fBdebchange\fR or its alias \fBdch\fR will add a new comment line to +the Debian changelog in the current source tree. This command must be +run from within that tree. If the text of the change is given on the +command line, \fBdebchange\fR will run in batch mode and simply add the +text, with line breaks as necessary, at the appropriate place in +\fIdebian/changelog\fR (or the changelog specified by options, as described +below). If the text given on the command line is a null string, +\fBdebchange\fR will run in batch mode without adding any text. If the +text given on the command line is a space string, \fBdebchange\fR will run +in batch mode and add a blank changelog entry. +If no text is specified then \fBdebchange\fR +will run the editor as determined by \fBsensible-editor\fR for you to +edit the file. (The environment variables \fBVISUAL\fR and +\fBEDITOR\fR are used in this order to determine which editor to use.) +Editors which understand the \fI+n\fR option for starting the editing +on a specified line will use this to move to the correct line of the +file for editing. If the editor is quit without modifying the +temporary file, \fBdebchange\fR will exit without touching the +existing changelog. \fBNote that the changelog is assumed to be +encoded with the UTF-8 encoding. If it is not, problems may occur.\fR +Please see the \fBiconv\fR(1) manpage to find out how to convert +changelogs from legacy encodings. Finally, a \fIchangelog\fR or \fINEWS\fR +file can be created from scratch using the \fB\-\-create\fR option +described below. +.PP +\fBdebchange\fR also supports automatically producing bug-closing +changelog entries, using the \fB\-\-closes\fR option. This will +usually query the BTS, the Debian Bug Tracking System (see +https://bugs.debian.org/) to determine the title of the bug and the +package in which it occurs. This behaviour can be stopped by giving a +\fB\-\-noquery\fR option or by setting the configuration variable +\fBDEBCHANGE_QUERY_BTS\fR to \fIno\fR, as described below. In either +case, the editor (as described above) will always be invoked to give +an opportunity to modify the entries, and the changelog will be +accepted whether or not modifications are made. An extra changelog +entry can be given on the command line in addition to the closes +entries. +.PP +At most one of \fB\-\-append\fR, \fB\-\-increment\fR, \fB\-\-edit\fR, +\fB\-\-release\fR, and \fB\-\-newversion\fR may be specified as listed +below. If no options are specified, \fBdebchange\fR will use heuristics to +guess whether or not the package has been successfully released, and behave +as if \fB\-\-increment\fR had been specified if the package has been +released, or otherwise as if \fB\-\-append\fR has been specified. +.PP +Two different sets of heuristics can be used, as controlled by the +\fB\-\-release-heuristic\fR option or the +\fBDEBCHANGE_RELEASE_HEURISTIC\fR configuration variable. The default +\fIchangelog\fR heuristic assumes the package has been released unless its +changelog contains \fBUNRELEASED\fR in the distribution field. If this heuristic +is enabled then the distribution will default to \fBUNRELEASED\fR in new +changelog entries, and the \fB\-\-mainttrailer\fR option described below will be +automatically enabled. This can be useful if a package can be released by +different maintainers, or if you do not keep the upload logs. The alternate +\fIlog\fR heuristic determines if a package has been released by looking for an +appropriate \fBdupload\fR(1) or \fBdput\fR(1) log file in the parent directory. +A warning will be issued if the log file is found but a successful upload is not +recorded. This may be because the previous upload was performed with a version +of \fBdupload\fR prior to 2.1 or because the upload failed. +.PP +If either \fB\-\-increment\fR or \fB\-\-newversion\fR is used, the +name and email for the new version will be determined as follows. If +the environment variable \fBDEBFULLNAME\fR is set, this will be used +for the maintainer full name; if not, then \fBNAME\fR will be checked. +If the environment variable \fBDEBEMAIL\fR is set, this will be used +for the email address. If this variable has the form "name ", +then the maintainer name will also be taken from here if neither +\fBDEBFULLNAME\fR nor \fBNAME\fR is set. If this variable is not set, +the same test is performed on the environment variable \fBEMAIL\fR. +Next, if the full name has still not been determined, then use +\fBgetpwuid\fR(3) to determine the name from the password file. If +this fails, use the previous changelog entry. For the email address, +if it has not been set from \fBDEBEMAIL\fR or \fBEMAIL\fR, then look +in \fI/etc/mailname\fR, then attempt to build it from the username and +FQDN, otherwise use the email address in the previous changelog entry. +In other words, it's a good idea to set \fBDEBEMAIL\fR and +\fBDEBFULLNAME\fR when using this script. +.PP +Support is included for changelogs that record changes by multiple +co-maintainers of a package. If an entry is appended to the current +version's entries, and the maintainer is different from the maintainer who +is listed as having done the previous entries, then lines will be added to +the changelog to tell which maintainers made which changes. Currently only +one of the several such styles of recording this information is supported, +in which the name of the maintainer who made a set of changes appears +on a line before the changes, inside square brackets. This can be +switched on and off using the \fB\-\-\fR[\fBno\fR]\fBmultimaint\fR option or the +\fBDEBCHANGE_MULTIMAINT\fR configuration file option; the default is to +enable it. Note that if an entry has already been marked in this way, +then this option will be silently ignored. +.PP +If the directory name of the source tree has the form +\fIpackage\fR-\fIversion\fR, then \fBdebchange\fR will also attempt to +rename it if the (upstream) version number changes. This can be +prevented by using the \fB\-\-preserve\fR command line or +configuration file option as described below. +.PP +If \fB\-\-force\-bad\-version\fR or \fB\-\-allow\-lower\-version\fR is used, +\fBdebchange\fR will not stop if the new version is less than the current one. +This is especially useful while doing backports. +.SH "Directory name checking" +In common with several other scripts in the \fBdevscripts\fR package, +\fBdebchange\fR will climb the directory tree until it finds a +\fIdebian/changelog\fR file. As a safeguard against stray files +causing potential problems, it will examine the name of the parent +directory once it finds the \fIdebian/changelog\fR file, and check +that the directory name corresponds to the package name. Precisely +how it does this is controlled by two configuration file variables +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR and \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR, and +their corresponding command-line options \fB\-\-check-dirname-level\fR +and \fB\-\-check-dirname-regex\fR. +.PP +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR can take the following values: +.TP +.B 0 +Never check the directory name. +.TP +.B 1 +Only check the directory name if we have had to change directory in +our search for \fIdebian/changelog\fR. This is the default behaviour. +.TP +.B 2 +Always check the directory name. +.PP +The directory name is checked by testing whether the current directory +name (as determined by \fBpwd\fR(1)) matches the regex given by the +configuration file option \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR or by the +command line option \fB\-\-check-dirname-regex\fR \fIregex\fR. Here +\fIregex\fR is a Perl regex (see \fBperlre\fR(3perl)), which will be +anchored at the beginning and the end. If \fIregex\fR contains a '\fB/\fR', +then it must match the full directory path. If not, then it must +match the full directory name. If \fIregex\fR contains the string +\'\fBPACKAGE\fR', this will be replaced by the source package name, as +determined from the changelog. The default value for the regex is: +\'\fBPACKAGE(-.+)?\fR', thus matching directory names such as \fBPACKAGE\fR and +\fBPACKAGE-\fIversion\fR. +.PP +The default changelog to be edited is \fIdebian/changelog\fR; however, +this can be changed using the \fB\-\-changelog\fR or \fB\-\-news\fR +options or the \fBCHANGELOG\fR environment variable, as described below. +.SH OPTIONS +.TP +.BR \-\-append ", " \-a +Add a new changelog entry at the end of the current version's entries. +.TP +.BR \-\-increment ", " \-i +Increment either the final component of the Debian release number or, +if this is a native Debian package, the version number. On Ubuntu or Tanglu, +this will also change the suffix from buildX to ubuntu1/tanglu1. Use +\fB\-R\fR, \fB\-\-rebuild\fR for a no change rebuild increment. This creates +a new section at the beginning of the changelog with appropriate +headers and footers. Also, if this is a new version of a native +Debian package, the directory name is changed to reflect this. +If \fBDEBCHANGE_RELEASE_HEURISTIC\fR is \fIchangelog\fR (default) and the +current release is \fIUNRELEASED\fR, this will only change the version of the +current changelog stanza. Otherwise, this will create a new changelog stanza +with the new version. +.TP +\fB\-\-newversion \fIversion\fR, \fB\-v \fIversion\fR +This specifies the version number (including the Debian release part) +explicitly and behaves as the \fB\-\-increment\fR option in other +respects. It will also change the directory name if the upstream +version number has changed. +If \fBDEBCHANGE_RELEASE_HEURISTIC\fR is \fIchangelog\fR (default) and the +current release is \fIUNRELEASED\fR, this will only change the version of the +current changelog stanza. Otherwise, this will create a new changelog stanza +with the new version. +.TP +.BR \-\-edit ", " \-e +Edit the changelog in an editor. +.TP +.BR \-\-release ", " \-r +Finalize the changelog for a release. +Update the changelog timestamp. If the distribution is set to +\fBUNRELEASED\fR, change it to the distribution from the previous changelog entry +(or another distribution as specified by \fB\-\-distribution\fR). If there are +no previous changelog entries and an explicit distribution has not been +specified, \fBunstable\fR will be used (or the name of the current development +release when run under Ubuntu). +.TP +.BR \-\-force\-save\-on\-release +When \fB\-\-release\fR is used, an editor is opened to allow inspection +of the changelog. The user is required to save the file to accept the modified +changelog, otherwise the original will be kept (default). +.TP +.BR \-\-no\-force\-save\-on\-release +Do not do so. Note that a dummy changelog entry may be supplied +in order to achieve the same effect - e.g. \fBdebchange \-\-release ""\fR. +The entry will not be added to the changelog but its presence will suppress +the editor. +.TP +.BR \-\-create +This will create a new \fIdebian/changelog\fR file (or \fINEWS\fR if +the \fB\-\-news\fR option is used). You must be in the top-level +directory to use this; no directory name checking will be performed. +The package name and version can either be specified using the +\fB\-\-package\fR and \fB\-\-newversion\fR options, determined from +the directory name using the \fB\-\-fromdirname\fR option or entered +manually into the generated \fIchangelog\fR file. The maintainer name is +determined from the environment if this is possible, and the +distribution is specified either using the \fB\-\-distribution\fR +option or in the generated \fIchangelog\fR file. +.TP +.BR \-\-empty +When used in combination with \fB\-\-create\fR, suppress the automatic +addition of an "\fBinitial release\fR" changelog entry (so that the next +invocation of \fBdebchange\fR adds the first entry). Note that this +will cause a \fBdpkg\-parsechangelog\fR warning on the next invocation +due to the lack of changes. +.TP +\fB\-\-package\fR \fIpackage\fR +This specifies the package name to be used in the new changelog; this +may only be used in conjunction with the \fB\-\-create\fR, \fB\-\-increment\fR and +\fB\-\-newversion\fR options. +.TP +.BR \-\-nmu ", " \-n +Increment the Debian release number for a non-maintainer upload by +either appending a "\fB.1\fR" to a non-NMU version number (unless the package +is Debian native, in which case "\fB+nmu1\fR" is appended) or by incrementing +an NMU version number, and add an NMU changelog comment. This happens +automatically if the packager is neither in the \fBMaintainer\fR nor the \fBUploaders\fR +field in \fIdebian/control\fR, unless \fBDEBCHANGE_AUTO_NMU\fR is set to +\fIno\fR or the \fB\-\-no\-auto\-nmu\fR option is used. +.TP +.BR \-\-bin\-nmu +Increment the Debian release number for a binary non-maintainer upload +by either appending a "\fB+b1\fR" to a non-binNMU version number or by +incrementing a binNMU version number, and add a binNMU changelog comment. +.TP +.BR \-\-qa ", " \-q +Increment the Debian release number for a Debian QA Team upload, and +add a \fBQA upload\fR changelog comment. +.TP +.BR \-\-rebuild ", " \-R +Increment the Debian release number for a no-change rebuild by +appending a "build1" or by incrementing a rebuild version number. +.TP +.BR \-\-security ", " \-s +Increment the Debian release number for a Debian Security Team non-maintainer +upload, and add a \fBSecurity Team upload\fR changelog comment. +.TP +.BR \-\-lts +Increment the Debian release number for a LTS Security Team non-maintainer +upload, and add a \fBLTS Security Team upload\fR changelog comment. +.TP +.B \-\-team +Increment the Debian release number for a team upload, and add a \fBTeam upload\fR +changelog comment. +.TP +.BR \-\-upstream ", " \-U +Don't append \fBdistro-name1\fR to the version on a derived +distribution. Increment the Debian version. +.TP +.B \-\-bpo +Increment the Debian release number for an upload to bullseye-backports, +and add a backport upload changelog comment. +.TP +.B \-\-stable +Increment the Debian release number for an upload to the current stable +release. +.TP +.BR \-\-local ", " \-l \fIsuffix\fR + Add a suffix to the Debian version number for a local build. +.TP +.BR \-\-force\-bad\-version ", " \-b +Force a version number to be less than the current one (e.g., when +backporting). +.TP +.B \-\-allow\-lower\-version \fIpattern\fR +Allow a version number to be less than the current one if the new version +matches the specified pattern. +.TP +.BR \-\-force\-distribution +Force the provided distribution to be used, even if it doesn't match the list of known +distributions (e.g. for unofficial distributions). +.TP +.BR \-\-auto\-nmu +Attempt to automatically determine whether a change to the changelog +represents a Non Maintainer Upload. This is the default. +.TP +.BR \-\-no\-auto\-nmu +Disable automatic NMU detection. Equivalent to setting +\fBDEBCHANGE_AUTO_NMU\fR to \fIno\fR. +.TP +.BR \-\-fromdirname ", " \-d +This will take the upstream version number from the directory name, +which should be of the form \fIpackage\fB-\fIversion\fR. If the +upstream version number has increased from the most recent changelog +entry, then a new entry will be made with version number +\fIversion\fB-1\fR (or \fIversion\fR if the package is Debian native), +with the same epoch as the previous package version. If the upstream +version number is the same, this option will behave in the same way as +\fB\-i\fR. +.TP +.BI \-\-closes " nnnnn\fR[\fB,\fInnnnn \fR...] +Add changelog entries to close the specified bug numbers. Also invoke +the editor after adding these entries. Will generate warnings if the +BTS cannot be contacted (and \fB\-\-noquery\fR has not been +specified), or if there are problems with the bug report located. +.TP +.B \-\-\fR[\fBno\fR]\fBquery +Should we attempt to query the BTS when generating closes entries? +.TP +.BR \-\-preserve ", " \-p +Preserve the source tree directory name if the upstream version number +(or the version number of a Debian native package) changes. See also +the configuration variables section below. +.TP +\fB \-\-no\-preserve\fR, \fB\-\-nopreserve\fR +Do not preserve the source tree directory name (default). +.TP +\fB\-\-vendor \fIvendor\fR +Override the distributor ID over the default returned by dpkg-vendor. +This name is used for heuristics applied to new package versions and for +sanity checking of the target distribution. +.TP +\fB\-\-distribution \fIdist\fR, \fB\-D \fIdist\fR +Use the specified distribution in the changelog entry being edited, +instead of using the previous changelog entry's distribution for new +entries or the existing value for existing entries. +.TP +\fB\-\-urgency \fIurgency\fR, \fB\-u \fIurgency\fR +Use the specified urgency in the changelog entry being edited, +instead of using the default "\fBmedium\fR" for new entries or the existing +value for existing entries. +.TP +\fB\-\-changelog \fIfile\fR, \fB\-c \fIfile\fR +This will edit the changelog \fIfile\fR instead of the standard +\fIdebian/changelog\fR. This option overrides any \fBCHANGELOG\fR +environment variable setting. Also, no directory traversing or +checking will be performed when this option is used. +.TP +\fB\-\-news\fR [\fInewsfile\fR] +This will edit \fInewsfile\fR (by default, \fIdebian/NEWS\fR) instead +of the regular changelog. Directory searching will be performed. +The changelog will be examined in order to determine the current package +version. +.TP +\fB\-\-\fR[\fBno\fR]\fBmultimaint\fR +Should we indicate that parts of a changelog entry have been made by +different maintainers? Default is yes; see the discussion above and +also the \fBDEBCHANGE_MULTIMAINT\fR configuration file option below. +.TP +\fB\-\-\fR[\fBno\fR]\fBmultimaint\-merge\fR +Should all changes made by the same author be merged into the same +changelog section? Default is no; see the discussion above and also the +\fBDEBCHANGE_MULTIMAINT_MERGE\fR configuration file option below. +.TP +.BR \-\-maintmaint ", " \-m +Do not modify the maintainer details previously listed in the changelog. +This is useful particularly for sponsors wanting to automatically add a +sponsorship message without disrupting the other changelog details. +Note that there may be some interesting interactions if +multi-maintainer mode is in use; you will probably wish to check the +changelog manually before uploading it in such cases. +.TP +.BR \-\-controlmaint ", " \-M +Use maintainer details from the \fIdebian/control\fR \fBMaintainer\fR field +rather than relevant environment variables (\fBDEBFULLNAME\fR, \fBDEBEMAIL\fR, +etc.). This option might be useful to restore details of the main maintainer +in the changelog trailer after a bogus edit (e.g. when \fB\-m\fR was intended +but forgot) or when releasing a package in the name of the main maintainer +(e.g. the team). +.TP +.BR \-\-\fR[\fBno\fR]\fBmainttrailer ", " \-t +If \fBmainttrailer\fR is set, it will avoid modifying the existing changelog +trailer line (i.e. the maintainer and date-stamp details), unless +used with options that require the trailer to be modified +(e.g. \fB\-\-create\fR, \fB\-\-release\fR, \fB\-i\fR, \fB\-\-qa\fR, etc.) +This option differs from \fB\-\-maintmaint\fR in that it will use +multi-maintainer mode if appropriate, with the exception of editing the +trailer. See also the \fBDEBCHANGE_MAINTTRAILER\fR configuration file option +below. +.TP +\fB\-\-check-dirname-level\fR \fIN\fR +See the above section "\fBDirectory name checking\fR" for an explanation of +this option. +.TP +\fB\-\-check-dirname-regex\fR \fIregex\fR +See the above section "\fBDirectory name checking\fR" for an explanation of +this option. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +\fB\-\-release\-heuristic\fR \fIlog\fR|\fIchangelog\fR +Controls how \fBdebchange\fR determines if a package has been released, +when deciding whether to create a new changelog entry or append to an +existing changelog entry. +.TP +.BR \-\-help ", " \-h +Display a help message and exit successfully. +.TP +.B \-\-version +Display version and copyright information and exit successfully. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced in that order to set configuration +variables. Command line options can be used to override configuration +file settings. Environment variable settings are ignored for this +purpose. The currently recognised variables are: +.TP +.B DEBCHANGE_PRESERVE +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-preserve\fR command line parameter being used. +.TP +.B DEBCHANGE_QUERY_BTS +If this is set to \fIno\fR, then it is the same as the +\fB\-\-noquery\fR command line parameter being used. +.TP +.BR DEVSCRIPTS_CHECK_DIRNAME_LEVEL ", " DEVSCRIPTS_CHECK_DIRNAME_REGEX +See the above section "\fBDirectory name checking\fR" for an explanation of +these variables. Note that these are package-wide configuration +variables, and will therefore affect all \fBdevscripts\fR scripts +which check their value, as described in their respective manpages and +in \fBdevscripts.conf\fR(5). +.TP +.BR DEBCHANGE_RELEASE_HEURISTIC +Controls how \fBdebchange\fR determines if a package has been released, +when deciding whether to create a new changelog entry or append to an +existing changelog entry. Can be either \fIlog\fR or \fIchangelog\fR. +.TP +.BR DEBCHANGE_MULTIMAINT +If set to \fIno\fR, \fBdebchange\fR will not introduce multiple-maintainer +distinctions when a different maintainer appends an entry to an +existing changelog. See the discussion above. Default is \fIyes\fR. +.TP +.BR DEBCHANGE_MULTIMAINT_MERGE +If set to \fIyes\fR, when adding changes in multiple-maintainer mode +\fBdebchange\fR will check whether previous changes by the current +maintainer exist and add the new changes to the existing block +rather than creating a new block. Default is \fIno\fR. +.TP +.BR DEBCHANGE_MAINTTRAILER +If this is set to \fIno\fR, then it is the same as the +\fB\-\-nomainttrailer\fR command line parameter being used. +.TP +.BR DEBCHANGE_TZ +Use this timezone for changelog entries. Default is the user/system +timezone as shown by `\fBdate \-R\fR` and affected by the environment variable \fBTZ\fR. +.TP +.BR DEBCHANGE_LOWER_VERSION_PATTERN +If this is set, then it is the same as the +\fB\-\-allow\-lower\-version\fR command line parameter being used. +.TP +.BR DEBCHANGE_AUTO_NMU +If this is set to \fIno\fR then \fBdebchange\fR will not attempt to +automatically determine whether the current changelog stanza represents +an NMU. The default is \fIyes\fR. See the discussion of the +\fB\-\-nmu\fR option above. +.TP +.BR DEBCHANGE_FORCE_SAVE_ON_RELEASE +If this is set to \fIno\fR, then it is the same as the +\fB\-\-no\-force\-save\-on\-release\fR command line parameter being used. +.TP +.B DEBCHANGE_VENDOR +Use this vendor instead of the default (dpkg-vendor output). See +\fB\-\-vendor\fR for details. +.SH ENVIRONMENT +.TP +.BR DEBEMAIL ", " EMAIL ", " DEBFULLNAME ", " NAME +See the above description of the use of these environment variables. +.TP +.B CHANGELOG +This variable specifies the changelog to edit in place of +\fIdebian/changelog\fR. No directory traversal or checking is +performed when this variable is set. This variable is overridden by +the \fB\-\-changelog\fR command-line setting. +.TP +.BR VISUAL ", " EDITOR +These environment variables (in this order) determine the editor used +by \fBsensible-editor\fR. +.SH "SEE ALSO" +.BR debc (1), +.BR debclean (1), +.BR dput (1), +.BR dupload (1), +.BR devscripts.conf (5) +.SH AUTHOR +The original author was Christoph Lameter . +Many substantial changes and improvements were made by Julian Gilbey +. diff --git a/scripts/debchange.bash_completion b/scripts/debchange.bash_completion new file mode 100644 index 0000000..d136eb6 --- /dev/null +++ b/scripts/debchange.bash_completion @@ -0,0 +1,90 @@ +# /usr/share/bash-completion/completions/debchange +# Bash command completion for ‘debchange(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +_debchange() +{ + local cur prev options + + COMPREPLY=() + cur=${COMP_WORDS[COMP_CWORD]} + prev=${COMP_WORDS[COMP_CWORD-1]} + options='-a --append -i --increment -v --newversion -e --edit\ + -r --release --force-save-on-release --no-force-save-on-release\ + --create --empty --package --auto-nmu --no-auto-nmu -n --nmu --lts\ + --bin-nmu -q --qa -R --rebuild -s --security --team -U --upstream\ + --bpo --stable -l --local -b --force-bad-version --allow-lower-version\ + --force-distribution --closes --noquery --query -d --fromdirname\ + -p --preserve --no-preserve --vendor -D --distribution\ + -u --urgency -c --changelog --news --nomultimaint --multimaint\ + --nomultimaint-merge --multimaint-merge -m --maintmaint\ + -M --controlmaint -t --mainttrailer --check-dirname-level\ + --check-dirname-regex --no-conf --noconf --release-heuristic\ + --help -h --version' + +#-------------------------------------------------------------------------- +#FIXME: I don't want hard-coding codename... +#-------------------------------------------------------------------------- + oldstable_codename='squeeze' + stable_codename='wheezy' + testing_codename='jessie' + + lts='squeeze-lts' + + distro="oldstable-security oldstable-proposed-updates\ + "$oldstable_codename"-security\ + "$oldstable_codename"-backports\ + "$oldstable_codename"-backports-sloppy\ + stable-security stable-proposed-updates\ + "$stable_codename"-security\ + "$stable_codename"-backports\ + "$stable_codename"-updates\ + testing-security testing-proposed-updates\ + "$testing_codename"-security\ + unstable experimental $lts" + + urgency='low medium high critical' + + case $prev in + --changelog | -c | --news) + COMPREPLY=( $( compgen -G "${cur}*" ) ) + ;; + --check-dirname-level) + COMPREPLY=( $( compgen -W [0 1 2] ) ) + ;; +#FIXME: we need "querybts --list" option with no verbose output +# --closes) +# package=`dpkg-parsechangelog -SSource` +# bugnumber=`querybts --list -b $package|grep ^#|cut -d' ' -f1` +# COMPREPLY=( $( compgen -W "$bugnumber" ) ) +# ;; + -D | --distribution) + COMPREPLY=( $( compgen -W "$distro" ) ) + ;; + --newversion | -v | --package | --local | -l | --allow-lower-version) + ;; + --release-heuristic) + COMPREPLY=( $( compgen -W 'log changelog' ) ) + ;; + -u | --urgency) + COMPREPLY=( $( compgen -W "$urgency" ) ) + ;; + *) + COMPREPLY=( $( + compgen -W "$options" | grep "^$cur" + ) ) + ;; + esac + + return 0 + +} +complete -F _debchange debchange dch + + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/debchange.pl b/scripts/debchange.pl new file mode 100755 index 0000000..f71dc61 --- /dev/null +++ b/scripts/debchange.pl @@ -0,0 +1,1883 @@ +#!/usr/bin/perl +# vim: set ai shiftwidth=4 tabstop=4 expandtab: + +# debchange: update the debian changelog using your favorite visual editor +# For options, see the usage message below. +# +# When creating a new changelog section, if either of the environment +# variables DEBEMAIL or EMAIL is set, debchange will use this as the +# uploader's email address (with the former taking precedence), and if +# DEBFULLNAME or NAME is set, it will use this as the uploader's full name. +# Otherwise, it will take the standard values for the current user or, +# failing that, just copy the values from the previous changelog entry. +# +# Originally by Christoph Lameter +# Modified extensively by Julian Gilbey +# +# Copyright 1999-2005 by Julian Gilbey +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +use 5.008; # We're using PerlIO layers +use strict; +use warnings; +use open ':utf8'; # changelogs are written with UTF-8 encoding +use filetest 'access'; # use access rather than stat for -w +# for checking whether user names are valid and making format() behave +use Encode qw/decode_utf8 encode_utf8/; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use File::Copy; +use File::Basename; +use Cwd; +use Dpkg::Vendor qw(get_current_vendor); +use Dpkg::Changelog::Parse qw(changelog_parse); +use Dpkg::Control; +use Dpkg::Version; +use Devscripts::Compression; +use Devscripts::Debbugs; +use POSIX qw(locale_h strftime); + +setlocale(LC_TIME, "C"); # so that strftime is locale independent + +# Predeclare functions +sub fatal($); +my $warnings = 0; + +# And global variables +my $progname = basename($0); +my $modified_conf_msg; +my %env; +my $CHGLINE; # used by the format O section at the end + +my $compression_re = compression_get_file_extension_regex(); + +my $debian_distro_info; + +sub get_debian_distro_info { + return $debian_distro_info if defined $debian_distro_info; + eval { require Debian::DistroInfo; }; + if ($@) { + printf "libdistro-info-perl is not installed, Debian release names " + . "are not known.\n"; + $debian_distro_info = 0; + } else { + $debian_distro_info = DebianDistroInfo->new(); + } + return $debian_distro_info; +} + +my $ubuntu_distro_info; + +sub get_ubuntu_distro_info { + return $ubuntu_distro_info if defined $ubuntu_distro_info; + eval { require Debian::DistroInfo; }; + if ($@) { + printf "libdistro-info-perl is not installed, Ubuntu release names " + . "are not known.\n"; + $ubuntu_distro_info = 0; + } else { + $ubuntu_distro_info = UbuntuDistroInfo->new(); + } + return $ubuntu_distro_info; +} + +sub get_ubuntu_devel_distro { + my $ubu_info = get_ubuntu_distro_info(); + if ($ubu_info == 0 or !$ubu_info->devel()) { + warn "$progname warning: Unable to determine the current Ubuntu " + . "development release. Using UNRELEASED instead.\n"; + return 'UNRELEASED'; + } else { + return $ubu_info->devel(); + } +} + +sub usage () { + print <<"EOF"; +Usage: $progname [options] [changelog entry] +Options: + -a, --append + Append a new entry to the current changelog + -i, --increment + Increase the Debian release number, adding a new changelog entry + -v , --newversion= + Add a new changelog entry with version number specified + -e, --edit + Don't change version number or add a new changelog entry, just + opens an editor + -r, --release + Update the changelog timestamp. If the distribution is set to + "UNRELEASED", change it to unstable (or another distribution as + specified by --distribution, or the name of the current development + release when run under Ubuntu). + --force-save-on-release + When --release is used and an editor opened to allow inspection + of the changelog, require the user to save the changelog their + editor opened. Otherwise, the original changelog will not be + modified. (default) + --no-force-save-on-release + Do not do so. Note that a dummy changelog entry may be supplied + in order to achieve the same effect - e.g. $progname --release "" + The entry will not be added to the changelog but its presence will + suppress the editor + --create + Create a new changelog (default) or NEWS file (with --news) and + open for editing + --empty + When creating a new changelog, don't add any changes to it + (i.e. only include the header and trailer lines) + --package + Specify the package name when using --create (optional) + --auto-nmu + Attempt to intelligently determine whether a change to the + changelog represents an NMU (default) + --no-auto-nmu + Do not do so + -n, --nmu + Increment the Debian release number for a non-maintainer upload + --bin-nmu + Increment the Debian release number for a binary non-maintainer upload + -q, --qa + Increment the Debian release number for a Debian QA Team upload + -R, --rebuild + Increment the Debian release number for a no-change rebuild + -s, --security + Increment the Debian release number for a Debian Security Team upload + --lts + Increment the Debian release number for a LTS Security Team upload + --team + Increment the Debian release number for a team upload + -U, --upstream + Increment the Debian release number without any appended derivative + distribution name + --bpo + Increment the Debian release number for a backports upload + to "bullseye-backports" + --stable + Increment the Debian release number for a stable upload. + -l, --local + Add a suffix to the Debian version number for a local build + -b, --force-bad-version + Force a version to be less than the current one (e.g., when + backporting) + --allow-lower-version + Allow a version to be less than the current one (e.g., when + backporting) if it matches the specified pattern + --force-distribution + Force the provided distribution to be used, even if it doesn't match + the list of known distributions + --closes nnnnn[,nnnnn,...] + Add entries for closing these bug numbers, + getting bug titles from the BTS (bug-tracking system, bugs.debian.org) + --[no]query + [Don\'t] try contacting the BTS to get bug titles (default: do query) + -d, --fromdirname + Add a new changelog entry with version taken from the directory name + -p, --preserve + Preserve the directory name + --no-preserve + Do not preserve the directory name (default) + --vendor + Override the distributor ID from dpkg-vendor. + -D, --distribution + Use the specified distribution in the changelog entry being edited + -u, --urgency + Use the specified urgency in the changelog entry being edited + -c, --changelog + Specify the name of the changelog to use in place of debian/changelog + No directory traversal or checking is performed in this case. + --news + Specify that the newsfile (default debian/NEWS) is to be edited + --[no]multimaint + When appending an entry to a changelog section (-a), [do not] + indicate if multiple maintainers are now involved (default: do so) + --[no]multimaint-merge + When appending an entry to a changelog section, [do not] merge the + entry into an existing changelog section for the current author. + (default: do not) + -m, --maintmaint + Don\'t change (maintain) the maintainer details in the changelog entry + -M, --controlmaint + Use maintainer name and email from the debian/control Maintainer field + -t, --mainttrailer + Don\'t change (maintain) the trailer line in the changelog entry; i.e. + maintain the maintainer and date/time details + --check-dirname-level N + How much to check directory names: + N=0 never + N=1 only if program changes directory (default) + N=2 always + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE\' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + --no-conf, --noconf + Don\'t read devscripts config files; must be the first option given + --release-heuristic log|changelog + Select heuristic used to determine if a package has been released. + (default: changelog) + --help, -h + Display this help message and exit + --version + Display version information + At most one of -a, -i, -e, -r, -v, -d, -n, --bin-nmu, -q, --qa, -R, -s, + --lts, --team, --bpo, --stable, -l (or their long equivalents) may be used. + With no options, one of -i or -a is chosen by looking at the release + specified in the changelog. + +Default settings modified by devscripts configuration files: +$modified_conf_msg +EOF +} + +sub version () { + print <<"EOF"; +This is $progname, from the Debian devscripts package, version 2.17.10 +This code is copyright 1999-2003 by Julian Gilbey, all rights reserved. +Based on code by Christoph Lameter. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. +EOF +} + +# Start by setting default values +my $check_dirname_level = 1; +my $check_dirname_regex = 'PACKAGE(-.+)?'; +my $opt_p = 0; +my $opt_query = 1; +my $opt_release_heuristic = 'changelog'; +my $opt_release_heuristic_re = '^(changelog|log)$'; +my $opt_multimaint = 1; +my $opt_multimaint_merge = 0; +my $opt_tz = undef; +my $opt_t = ''; +my $opt_allow_lower = ''; +my $opt_auto_nmu = 1; +my $opt_force_save_on_release = 1; +my $opt_vendor = undef; + +# Next, read configuration files and then command line +# The next stuff is boilerplate + +if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { + $modified_conf_msg = " (no configuration files read)"; + shift; +} else { + my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); + my %config_vars = ( + 'DEBCHANGE_PRESERVE' => 'no', + 'DEBCHANGE_QUERY_BTS' => 'yes', + 'DEVSCRIPTS_CHECK_DIRNAME_LEVEL' => 1, + 'DEVSCRIPTS_CHECK_DIRNAME_REGEX' => 'PACKAGE(-.+)?', + 'DEBCHANGE_RELEASE_HEURISTIC' => 'changelog', + 'DEBCHANGE_MULTIMAINT' => 'yes', + 'DEBCHANGE_TZ' => $ENV{TZ}, # undef if TZ unset + 'DEBCHANGE_MULTIMAINT_MERGE' => 'no', + 'DEBCHANGE_MAINTTRAILER' => '', + 'DEBCHANGE_LOWER_VERSION_PATTERN' => '', + 'DEBCHANGE_AUTO_NMU' => 'yes', + 'DEBCHANGE_FORCE_SAVE_ON_RELEASE' => 'yes', + 'DEBCHANGE_VENDOR' => '', + ); + $config_vars{'DEBCHANGE_TZ'} ||= ''; + my %config_default = %config_vars; + + my $shell_cmd; + # Set defaults + foreach my $var (keys %config_vars) { + $shell_cmd .= qq[$var="$config_vars{$var}";\n]; + } + $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; + $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; + # Read back values + foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } + my $shell_out = `/bin/bash -c '$shell_cmd'`; + @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; + + # Check validity + $config_vars{'DEBCHANGE_PRESERVE'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_PRESERVE'} = 'no'; + $config_vars{'DEBCHANGE_QUERY_BTS'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_QUERY_BTS'} = 'yes'; + $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} =~ /^[012]$/ + or $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} = 1; + $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'} =~ $opt_release_heuristic_re + or $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'} = 'changelog'; + $config_vars{'DEBCHANGE_MULTIMAINT'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_MULTIMAINT'} = 'yes'; + $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} = 'no'; + $config_vars{'DEBCHANGE_AUTO_NMU'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_AUTO_NMU'} = 'yes'; + $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} =~ /^(yes|no)$/ + or $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} = 'yes'; + + foreach my $var (sort keys %config_vars) { + if ($config_vars{$var} ne $config_default{$var}) { + $modified_conf_msg .= " $var=$config_vars{$var}\n"; + } + } + $modified_conf_msg ||= " (none)\n"; + chomp $modified_conf_msg; + + $opt_p = $config_vars{'DEBCHANGE_PRESERVE'} eq 'yes' ? 1 : 0; + $opt_query = $config_vars{'DEBCHANGE_QUERY_BTS'} eq 'no' ? 0 : 1; + $check_dirname_level = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'}; + $check_dirname_regex = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_REGEX'}; + $opt_release_heuristic = $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'}; + $opt_multimaint = $config_vars{'DEBCHANGE_MULTIMAINT'} eq 'no' ? 0 : 1; + $opt_tz = $config_vars{'DEBCHANGE_TZ'}; + $opt_multimaint_merge + = $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} eq 'no' ? 0 : 1; + $opt_t = ($config_vars{'DEBCHANGE_MAINTTRAILER'} eq 'no' ? 0 : 1) + if $config_vars{'DEBCHANGE_MAINTTRAILER'}; + $opt_allow_lower = $config_vars{'DEBCHANGE_LOWER_VERSION_PATTERN'}; + $opt_auto_nmu = $config_vars{'DEBCHANGE_AUTO_NMU'} eq 'yes'; + $opt_force_save_on_release + = $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} eq 'yes' ? 1 : 0; + $opt_vendor = $config_vars{'DEBCHANGE_VENDOR'}; +} + +# We use bundling so that the short option behaviour is the same as +# with older debchange versions. +my ($opt_help, $opt_version); +my ( + $opt_i, $opt_a, $opt_e, $opt_r, $opt_v, + $opt_b, $opt_d, $opt_D, $opt_u, $opt_force_dist +); +my ( + $opt_n, $opt_bn, $opt_qa, $opt_R, $opt_s, + $opt_lts, $opt_team, $opt_U, $opt_bpo, $opt_stable, + $opt_l, $opt_c, $opt_m, $opt_M, $opt_create, + $opt_package, @closes +); +my ($opt_news); +my ($opt_noconf, $opt_empty); + +Getopt::Long::Configure('bundling'); +GetOptions( + "help|h" => \$opt_help, + "version" => \$opt_version, + "i|increment" => \$opt_i, + "a|append" => \$opt_a, + "e|edit" => \$opt_e, + "r|release" => \$opt_r, + "create" => \$opt_create, + "package=s" => \$opt_package, + "v|newversion=s" => \$opt_v, + "b|force-bad-version" => \$opt_b, + "allow-lower-version=s" => \$opt_allow_lower, + "force-distribution" => \$opt_force_dist, + "d|fromdirname" => \$opt_d, + "p" => \$opt_p, + "preserve!" => \$opt_p, + "D|distribution=s" => \$opt_D, + "u|urgency=s" => \$opt_u, + "n|nmu" => \$opt_n, + "bin-nmu" => \$opt_bn, + "q|qa" => \$opt_qa, + "R|rebuild" => \$opt_R, + "s|security" => \$opt_s, + "team" => \$opt_team, + "U|upstream" => \$opt_U, + "bpo" => \$opt_bpo, + "lts" => \$opt_lts, + "stable" => \$opt_stable, + "l|local=s" => \$opt_l, + "query!" => \$opt_query, + "closes=s" => \@closes, + "c|changelog=s" => \$opt_c, + "news:s" => \$opt_news, + "multimaint!" => \$opt_multimaint, + "multi-maint!" => \$opt_multimaint, + 'multimaint-merge!' => \$opt_multimaint_merge, + 'multi-maint-merge!' => \$opt_multimaint_merge, + "m|maintmaint" => \$opt_m, + "M|controlmaint" => \$opt_M, + "t|mainttrailer!" => \$opt_t, + "check-dirname-level=s" => \$check_dirname_level, + "check-dirname-regex=s" => \$check_dirname_regex, + "noconf" => \$opt_noconf, + "no-conf" => \$opt_noconf, + "release-heuristic=s" => \$opt_release_heuristic, + "empty" => \$opt_empty, + "auto-nmu!" => \$opt_auto_nmu, + "force-save-on-release!" => \$opt_force_save_on_release, + "vendor=s" => \$opt_vendor, + ) + or die +"Usage: $progname [options] [changelog entry]\nRun $progname --help for more details\n"; + +# So that we can distinguish, if required, between an explicit +# passing of -a / -i and their values being automagically deduced +# later on +my $opt_a_passed = $opt_a || 0; +my $opt_i_passed = $opt_i || 0; +$opt_news = 'debian/NEWS' if defined $opt_news and $opt_news eq ''; + +if ($opt_t eq '' && $opt_release_heuristic eq 'changelog') { + $opt_t = 1; +} + +if ($opt_noconf) { + fatal "--no-conf is only acceptable as the first command-line option!"; +} +if ($opt_help) { usage; exit 0; } +if ($opt_version) { version; exit 0; } + +if ($check_dirname_level !~ /^[012]$/) { + fatal "Unrecognised --check-dirname-level value (allowed are 0,1,2)"; +} +if ($opt_release_heuristic !~ $opt_release_heuristic_re) { + fatal "Allowed values for --release-heuristics are log and changelog."; +} + +# Only allow at most one non-help option +fatal +"Only one of -a, -i, -e, -r, -v, -d, -n/--nmu, --bin-nmu, -q/--qa, -R/--rebuild, -s/--security, --lts, --team, --bpo, --stable, -l/--local is allowed;\ntry $progname --help for more help" + if ($opt_i ? 1 : 0) + + ($opt_a ? 1 : 0) + + ($opt_e ? 1 : 0) + + ($opt_r ? 1 : 0) + + ($opt_v ? 1 : 0) + + ($opt_d ? 1 : 0) + + ($opt_n ? 1 : 0) + + ($opt_bn ? 1 : 0) + + ($opt_qa ? 1 : 0) + + ($opt_R ? 1 : 0) + + ($opt_s ? 1 : 0) + + ($opt_lts ? 1 : 0) + + ($opt_team ? 1 : 0) + + ($opt_bpo ? 1 : 0) + + ($opt_stable ? 1 : 0) + + ($opt_l ? 1 : 0) > 1; + +if ($opt_s) { + $opt_u = "high"; +} + +if (defined $opt_u) { + fatal "Urgency can only be one of: low, medium, high, critical, emergency" + unless $opt_u =~ /^(low|medium|high|critical|emergency)$/; +} + +# See if we're Debian, Ubuntu or someone else, if we can +my $vendor; +if (defined $opt_vendor && $opt_vendor) { + $vendor = $opt_vendor; +} else { + if (defined $opt_D) { + # Try to guess the vendor based on the given distribution name + my $distro = $opt_D; + $distro =~ s/-.*//; + my $deb_info = get_debian_distro_info(); + my $ubu_info = get_ubuntu_distro_info(); + if ($deb_info != 0 and $deb_info->valid($distro)) { + $vendor = 'Debian'; + } elsif ($ubu_info != 0 and $ubu_info->valid($distro)) { + $vendor = 'Ubuntu'; + } + } + if (not defined $vendor) { + # Get the vendor from dpkg-vendor (dpkg-vendor --query Vendor) + $vendor = get_current_vendor(); + } +} +$vendor ||= 'Debian'; +if ($vendor eq 'Ubuntu' + and ($opt_n or $opt_bn or $opt_qa or $opt_bpo or $opt_stable or $opt_lts)) +{ + $vendor = 'Debian'; +} + +# Check the distro name given. +if (defined $opt_D) { + if ($vendor eq 'Debian') { + unless ($opt_D + =~ /^(experimental|unstable|sid|UNRELEASED|((old){0,2}stable|testing|wheezy|jessie|stretch|buster|bullseye)(-proposed-updates|-security)?|proposed-updates)$/ + ) { + my $deb_info = get_debian_distro_info(); + my ($oldstable_backports, $stable_backports) = ("", ""); + if ($deb_info == 0) { + warn +"$progname warning: Unable to determine Debian's backport distributions.\n"; + } else { + $stable_backports = $deb_info->stable() . "-backports"; +# Silence any potential warnings $deb_info emits when oldstable is no longer supported + local $SIG{__WARN__} = sub { }; + my $oldstable = $deb_info->old(); + $oldstable_backports = "$oldstable-backports" if $oldstable; + } + if ( $deb_info == 0 + || $opt_D + !~ m/^(\Q$stable_backports\E|\Q$oldstable_backports\E)$/) { + $stable_backports = ", " . $stable_backports + if $stable_backports; + $oldstable_backports = ", " . $oldstable_backports + if $oldstable_backports; + warn "$progname warning: Recognised distributions are: \n" + . "experimental, unstable, testing, stable, oldstable, oldoldstable,\n" + . "{bullseye,buster,stretch,jessie,wheezy}-proposed-updates,\n" + . "{testing,stable,oldstable,oldoldstable}-proposed-updates,\n" + . "{bullseye,buster,stretch,jessie,wheezy}-security,\n" + . "{testing,stable,oldstable,oldoldstable}}-security$oldstable_backports$stable_backports and UNRELEASED.\n" + . "Using your request anyway.\n"; + $warnings++ if not $opt_force_dist; + } + } + } elsif ($vendor eq 'Ubuntu') { + if ($opt_D eq 'UNRELEASED') { + ; + } else { + my $ubu_release = $opt_D; + $ubu_release =~ s/(-updates|-security|-proposed|-backports)$//; + my $ubu_info = get_ubuntu_distro_info(); + if ($ubu_info == 0) { + warn "$progname warning: Unable to determine if $ubu_release " + . "is a valid Ubuntu release.\n"; + } elsif (!$ubu_info->valid($ubu_release)) { + warn "$progname warning: Recognised distributions are:\n{" + . join(',', $ubu_info->supported()) + . "}{,-updates,-security,-proposed,-backports} and UNRELEASED.\n" + . "Using your request anyway.\n"; + $warnings++ if not $opt_force_dist; + } + } + } else { + # Unknown vendor, skip check + } +} + +fatal +"--closes should not be used with --news; put bug numbers in the changelog not the NEWS file" + if $opt_news && @closes; + +# hm, this can probably be used with more than just -i. +fatal "--package can only be used with --create, --increment and --newversion" + if $opt_package && !($opt_create || $opt_i || $opt_v); + +my $changelog_path = $opt_c || $ENV{'CHANGELOG'} || 'debian/changelog'; +my $real_changelog_path = $changelog_path; +if ($opt_news) { $changelog_path = $opt_news; } +if ($changelog_path ne 'debian/changelog' and not $opt_news) { + $check_dirname_level = 0; +} + +# extra --create checks +fatal "--package cannot be used when creating a NEWS file" + if $opt_package && $opt_news; + +if ($opt_create) { + if ( $opt_a + || $opt_i + || $opt_e + || $opt_r + || $opt_b + || $opt_n + || $opt_bn + || $opt_qa + || $opt_R + || $opt_s + || $opt_lts + || $opt_team + || $opt_bpo + || $opt_stable + || $opt_l + || $opt_allow_lower) { + warn +"$progname warning: ignoring -a/-i/-e/-r/-b/--allow-lower-version/-n/--bin-nmu/-q/--qa/-R/-s/--lts/--team/--bpo/--stable,-l options with --create\n"; + $warnings++; + } + if ($opt_package && $opt_d) { + fatal "Can only use one of --package and -d"; + } +} + +@closes = split(/,/, join(',', @closes)); +map { s/^\#//; } @closes; # remove any leading # from bug numbers + +# We'll process the rest of the command line later. + +# Look for the changelog +my $chdir = 0; +if (!$opt_create) { + if ($changelog_path eq 'debian/changelog' or $opt_news) { + until (-f $changelog_path) { + $chdir = 1; + chdir '..' or fatal "Can't chdir ..: $!"; + if (cwd() eq '/') { + fatal +"Cannot find $changelog_path anywhere!\nAre you in the source code tree?\n(You could use --create if you wish to create this file.)"; + } + } + + # Can't write, so stop now. + if (!-w $changelog_path) { + fatal "$changelog_path is not writable!"; + } + } else { + unless (-f $changelog_path) { + fatal +"Cannot find $changelog_path!\nAre you in the correct directory?\n(You could use --create if you wish to create this file.)"; + } + + # Can't write, so stop now. + if (!-w $changelog_path) { + fatal "$changelog_path is not writable!"; + } + } +} else { # $opt_create + unless (-d dirname $changelog_path) { + fatal "Cannot find " + . (dirname $changelog_path) + . " directory!\nAre you in the correct directory?"; + } + if (-f $changelog_path) { + fatal "File $changelog_path already exists!"; + } + unless (-w dirname $changelog_path) { + fatal "Cannot find " + . (dirname $changelog_path) + . " directory!\nAre you in the correct directory?"; + } + if ($opt_news && !-f 'debian/changelog') { + fatal "I can't create $opt_news without debian/changelog present"; + } +} + +##### + +# Find the current version number etc. +my $changelog; +my $PACKAGE = 'PACKAGE'; +my $VERSION = 'VERSION'; +my $MAINTAINER = 'MAINTAINER'; +my $EMAIL = 'EMAIL'; +my $DISTRIBUTION = 'UNRELEASED'; +# when updating the lines below also update the help text, the manpage and the testcases. +my %dists + = (8, 'jessie', 9, 'stretch', 10, 'buster', 11, 'bullseye', 12, 'bookworm'); +my $lts_dist = '9'; +my $latest_dist = '11'; +# dist guessed from backports, SRU, security uploads... +my $guessed_dist = ''; +my $CHANGES = ''; +# Changelog urgency, possibly propagated to NEWS files +my $CL_URGENCY = ''; + +if (!$opt_create || ($opt_create && $opt_news)) { + my $file = $opt_create ? 'debian/changelog' : $changelog_path; + $changelog = changelog_parse(file => $file); + + # Now we've read the changelog, set some variables and then + # let's check the directory name is sensible + fatal "No package name in changelog!" + unless exists $changelog->{Source}; + $PACKAGE = $changelog->{Source}; + fatal "No version number in changelog!" + unless exists $changelog->{Version}; + $VERSION = $changelog->{Version}; + fatal "No maintainer in changelog!" + unless exists $changelog->{Maintainer}; + $changelog->{Maintainer} = decode_utf8($changelog->{Maintainer}); + ($MAINTAINER, $EMAIL) = ($changelog->{Maintainer} =~ /^([^<]*) <(.*)>/); + $MAINTAINER ||= ''; + fatal "No distribution in changelog!" + unless exists $changelog->{Distribution}; + + if ($vendor eq 'Ubuntu') { + # In Ubuntu the development release regularly changes, don't just copy + # the previous name. + $DISTRIBUTION = get_ubuntu_devel_distro(); + } else { + $DISTRIBUTION = $changelog->{Distribution}; + } + fatal "No changes in changelog!" + unless exists $changelog->{Changes}; + + # Find the current package version + if ($opt_news) { + my $found_version = 0; + my $found_urgency = 0; + my $clog = changelog_parse(file => $real_changelog_path); + $VERSION = $clog->{Version}; + $VERSION =~ s/~$//; + + $CL_URGENCY = $clog->{Urgency}; + } + + # Is the directory name acceptable? + if ($check_dirname_level == 2 + or ($check_dirname_level == 1 and $chdir)) { + my $re = $check_dirname_regex; + $re =~ s/PACKAGE/\\Q$PACKAGE\\E/g; + my $gooddir; + if ($re =~ m%/%) { $gooddir = eval "cwd() =~ /^$re\$/;"; } + else { $gooddir = eval "basename(cwd()) =~ /^$re\$/;"; } + + if (!$gooddir) { + my $pwd = cwd(); + fatal <<"EOF"; +Found debian/changelog for package $PACKAGE in the directory + $pwd +but this directory name does not match the package name according to the +regex $check_dirname_regex. + +To run $progname on this package, see the --check-dirname-level and +--check-dirname-regex options; run $progname --help for more info. +EOF + } + } +} else { + # we're creating and we don't know much about our package + if ($opt_d) { + my $pwd = basename(cwd()); + # The directory name should be - + my $version_chars = '0-9a-zA-Z+\.\-'; + if ($pwd =~ m/^([a-z0-9][a-z0-9+\-\.]+)-([0-9][$version_chars]*)$/) { + $PACKAGE = $1; + $VERSION = "$2-1"; # introduce a Debian version of -1 + } elsif ($pwd =~ m/^[a-z0-9][a-z0-9+\-\.]+$/) { + $PACKAGE = $pwd; + } else { + # don't know anything + } + } + if ($opt_v) { + $VERSION = $opt_v; + } + if ($opt_D) { + $DISTRIBUTION = $opt_D; + } +} + +if ($opt_package) { + if ($opt_package =~ m/^[a-z0-9][a-z0-9+\-\.]+$/) { + $PACKAGE = $opt_package; + } else { + warn +"$progname warning: illegal package name used with --package: $opt_package\n"; + $warnings++; + } +} + +# Clean up after old versions of debchange +if (-f "debian/RELEASED") { + unlink("debian/RELEASED"); +} + +if (-e "$changelog_path.dch") { + fatal "The backup file $changelog_path.dch already exists --\n" + . "please move it before trying again"; +} + +# Is this a native Debian package, i.e., does it have a - in the +# version number? +(my $EPOCH) = ($VERSION =~ /^(\d+):/); +(my $SVERSION = $VERSION) =~ s/^\d+://; +(my $UVERSION = $SVERSION) =~ s/-[^-]*$//; + +# Check, sanitise and decode these environment variables +check_env_utf8('DEBFULLNAME'); +check_env_utf8('NAME'); +check_env_utf8('DEBEMAIL'); +check_env_utf8('EMAIL'); +check_env_utf8('UBUMAIL'); + +if (exists $env{'DEBEMAIL'} and $env{'DEBEMAIL'} =~ /^(.*)\s+<(.*)>$/) { + $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'}; + $env{'DEBEMAIL'} = $2; +} +if (!exists $env{'DEBEMAIL'} or !exists $env{'DEBFULLNAME'}) { + if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) { + $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'}; + $env{'EMAIL'} = $2; + } +} +if (exists $env{'UBUMAIL'} and $env{'UBUMAIL'} =~ /^(.*)\s+<(.*)>$/) { + $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'}; + $env{'UBUMAIL'} = $2; +} + +# Now use the gleaned values to determine our MAINTAINER and EMAIL values +if (!$opt_m and !$opt_M) { + if (exists $env{'DEBFULLNAME'}) { + $MAINTAINER = $env{'DEBFULLNAME'}; + } elsif (exists $env{'NAME'}) { + $MAINTAINER = $env{'NAME'}; + } else { + my @pw = getpwuid $<; + if ($pw[6]) { + if (my $pw = decode_utf8($pw[6])) { + $pw =~ s/,.*//; + $MAINTAINER = $pw; + } else { + warn +"$progname warning: passwd full name field for uid $<\nis not UTF-8 encoded; ignoring\n"; + $warnings++; + } + } + } + # Otherwise, $MAINTAINER retains its default value of the last + # changelog entry + + # Email is easier + if ($vendor eq 'Ubuntu' and exists $env{'UBUMAIL'}) { + $EMAIL = $env{'UBUMAIL'}; + } elsif (exists $env{'DEBEMAIL'}) { + $EMAIL = $env{'DEBEMAIL'}; + } elsif (exists $env{'EMAIL'}) { + $EMAIL = $env{'EMAIL'}; + } else { + warn +"$progname warning: neither DEBEMAIL nor EMAIL environment variable is set\n"; + $warnings++; + my $addr; + if (open MAILNAME, '/etc/mailname') { + warn +"$progname warning: building email address from username and mailname\n"; + $warnings++; + chomp($addr = ); + close MAILNAME; + } + if (!$addr) { + warn +"$progname warning: building email address from username and FQDN\n"; + $warnings++; + chomp($addr = `hostname --fqdn 2>/dev/null`); + $addr = undef if $?; + } + if ($addr) { + my $user = getpwuid $<; + if (!$user) { + $addr = undef; + } else { + $addr = "$user\@$addr"; + } + } + $EMAIL = $addr if $addr; + } + # Otherwise, $EMAIL retains its default value of the last changelog entry +} # if (! $opt_m and ! $opt_M) + +if ($opt_M) { + if (-f 'debian/control') { + my $parser = Dpkg::Control->new(type => CTRL_INFO_SRC); + $parser->load('debian/control'); + my $maintainer = decode_utf8($parser->{Maintainer}); + if ($maintainer =~ /^(.*)\s+<(.*)>$/) { + $MAINTAINER = $1; + $EMAIL = $2; + } else { + fatal "$progname: invalid debian/control Maintainer field value\n"; + } + } else { + fatal "Missing file debian/control"; + } +} + +##### + +if ( + $opt_auto_nmu + and !$opt_v + and !$opt_l + and !$opt_s + and !$opt_lts + and !$opt_team + and !$opt_qa + and !$opt_R + and !$opt_bpo + and !$opt_bn + and !$opt_n + and !$opt_c + and !$opt_stable + and !(exists $ENV{'CHANGELOG'} and length $ENV{'CHANGELOG'}) + and !$opt_M + and !$opt_create + and !$opt_a_passed + and !$opt_r + and !$opt_e + and $vendor ne 'Ubuntu' + and $vendor ne 'Tanglu' + and !( + $opt_release_heuristic eq 'changelog' + and $changelog->{Distribution} eq 'UNRELEASED' + and !$opt_i_passed + ) +) { + + if (-f 'debian/control') { + my $parser = Dpkg::Control->new(type => CTRL_INFO_SRC); + $parser->load('debian/control'); + my $uploader = decode_utf8($parser->{Uploaders}) || ''; + $uploader =~ s/^\s+//; + my $maintainer = decode_utf8($parser->{Maintainer}); + my @uploaders = split(/\s*,\s*/, $uploader); + + my $packager = "$MAINTAINER <$EMAIL>"; + + if ( $maintainer !~ m// + and !grep { $_ eq $packager } ($maintainer, @uploaders) + and $packager ne $changelog->{Maintainer} + and !$opt_team) { + $opt_n = 1; + $opt_a = 0; + } + } else { + fatal "Missing file debian/control"; + } +} +##### + +# Do we need to generate "closes" entries? + +my @closes_text = (); +my $initial_release = 0; +if (@closes and $opt_query) { # and we have to query the BTS + if (!Devscripts::Debbugs::have_soap) { + warn +"$progname warning: libsoap-lite-perl not installed, so cannot query the bug-tracking system\n"; + $opt_query = 0; + $warnings++; + # This will now go and execute the "if (@closes and ! $opt_query)" code + } else { + my $bugs = Devscripts::Debbugs::select("src:" . $PACKAGE); + my $statuses = Devscripts::Debbugs::status( + map { [bug => $_, indicatesource => 1] } @{$bugs}); + if ($statuses eq "") { + warn "$progname: No bugs found for package $PACKAGE\n"; + } + foreach my $close (@closes) { + if ($statuses and exists $statuses->{$close}) { + my $title = $statuses->{$close}->{subject}; + my $pkg = $statuses->{$close}->{package}; + $title =~ s/^($pkg|$PACKAGE): //; + push @closes_text, +"Fix \"$title\" (Closes: \#$close)\n"; + } else { # not our package, or wnpp + my $bug = Devscripts::Debbugs::status( + [bug => $close, indicatesource => 1]); + if ($bug eq "") { + warn +"$progname warning: unknown bug \#$close does not belong to $PACKAGE,\n disabling closing changelog entry\n"; + $warnings++; + push @closes_text, + "Closes?? \#$close: UNKNOWN BUG IN WRONG PACKAGE!!\n"; + } else { + my $bugtitle = $bug->{$close}->{subject}; + $bugtitle ||= ''; + my $bugpkg = $bug->{$close}->{package}; + $bugpkg ||= '?'; + my $bugsrcpkg = $bug->{$close}->{source}; + $bugsrcpkg ||= '?'; + if ($bugsrcpkg eq $PACKAGE) { + warn +"$progname warning: bug \#$close appears to be already archived,\n disabling closing changelog entry\n"; + $warnings++; + push @closes_text, +"Closes?? \#$close: ALREADY ARCHIVED? $bugtitle!!\n"; + } elsif ($bugpkg eq 'wnpp') { + if ($bugtitle =~ /(^(O|RFA|ITA): )/) { + push @closes_text, +"New maintainer. (Closes: \#$close: $bugtitle)\n"; + } elsif ($bugtitle =~ /(^(RFP|ITP): )/) { + push @closes_text, +"Initial release. (Closes: \#$close: $bugtitle)\n"; + $initial_release = 1; + } + } else { + warn +"$progname warning: bug \#$close belongs to package $bugpkg (src $bugsrcpkg),\n not to $PACKAGE: disabling closing changelog entry\n"; + $warnings++; + push @closes_text, + "Closes?? \#$close: WRONG PACKAGE!! $bugtitle\n"; + } + } + } + } + } +} + +if (@closes and !$opt_query) { # and we don't have to query the BTS + foreach my $close (@closes) { + unless ($close =~ /^\d{3,}$/) { + warn "$progname warning: Bug number $close is invalid; ignoring\n"; + $warnings++; + next; + } + push @closes_text, "Closes: \#$close: \n"; + } +} + +# Get a possible changelog entry from the command line +my $ARGS = join(' ', @ARGV); +my $TEXT = decode_utf8($ARGS); +my $EMPTY_TEXT = 0; + +if (@ARGV and !$TEXT) { + if ($ARGS) { + warn +"$progname warning: command-line changelog entry not UTF-8 encoded; ignoring\n"; + $TEXT = ''; + } else { + $EMPTY_TEXT = 1; + } +} + +# Get the date +my $DATE; +{ + local $ENV{TZ} = $opt_tz if $opt_tz; + $DATE = strftime "%a, %d %b %Y %T %z", localtime(); +} + +if ($opt_news && !$opt_i && !$opt_a) { + if ($VERSION eq $changelog->{Version} && !$opt_v && !$opt_l) { + $opt_a = 1; + } else { + $opt_i = 1; + } +} + +# Are we going to have to figure things out for ourselves? +if ( !$opt_i + && !$opt_v + && !$opt_d + && !$opt_a + && !$opt_e + && !$opt_r + && !$opt_n + && !$opt_bn + && !$opt_qa + && !$opt_R + && !$opt_s + && !$opt_lts + && !$opt_team + && !$opt_bpo + && !$opt_stable + && !$opt_l + && !$opt_create) { + # Yes, we are + if ($opt_release_heuristic eq 'log') { + my @UPFILES = glob("../$PACKAGE\_$SVERSION\_*.upload"); + if (@UPFILES > 1) { + fatal "Found more than one appropriate .upload file!\n" + . "Please use an explicit -a, -i or -v option instead."; + } elsif (@UPFILES == 0) { + $opt_a = 1; + } else { + open UPFILE, "<${UPFILES[0]}" + or fatal "Couldn't open .upload file for reading: $!\n" + . "Please use an explicit -a, -i or -v option instead."; + while () { + if ( +m%^(s|Successfully uploaded) (/.*/)?\Q$PACKAGE\E\_\Q$SVERSION\E\_[\w\-\+]+\.changes % + ) { + $opt_i = 1; + last; + } + } + close UPFILE + or fatal "Problems experienced reading .upload file: $!\n" + . "Please use an explicit -a, -i or -v option instead."; + if (!$opt_i) { + warn +"$progname warning: A successful upload of the current version was not logged\n" + . "in the upload log file; adding log entry to current version.\n"; + $opt_a = 1; + } + } + } elsif ($opt_release_heuristic eq 'changelog') { + if ($changelog->{Distribution} eq 'UNRELEASED') { + $opt_a = 1; + } elsif ($EMPTY_TEXT == 1) { + $opt_a = 1; + } else { + $opt_i = 1; + } + } else { + fatal "Bad release heuristic value"; + } +} + +# Open in anticipation.... +unless ($opt_create) { + open S, $changelog_path + or fatal "Cannot open existing $changelog_path: $!"; + + # Read the first stanza from the changelog file + # We do this directly rather than reusing $changelog->{Changes} + # so that we have the verbatim changes rather than a (albeit very + # slightly) reformatted version. See Debian bug #452806 + + while () { + last if /^ --/; + + $CHANGES .= $_; + } + + chomp $CHANGES; + + # Reset file pointer + seek(S, 0, 0); +} +open O, ">$changelog_path.dch" + or fatal "Cannot write to temporary file: $!"; +# Turn off form feeds; taken from perlform +select((select(O), $^L = "")[0]); + +# Note that we now have to remove it +my $tmpchk = 1; +my ($NEW_VERSION, $NEW_SVERSION, $NEW_UVERSION); +my $line; +my $optionsok = 0; +my $merge = 0; + +if (( + $opt_i + || $opt_n + || $opt_bn + || $opt_qa + || $opt_R + || $opt_s + || $opt_lts + || $opt_team + || $opt_bpo + || $opt_stable + || $opt_l + || $opt_v + || $opt_d + || ($opt_news && $VERSION ne $changelog->{Version})) + && !$opt_create +) { + + $optionsok = 1; + + # Check that a given explicit version number is sensible. + if ($opt_v || $opt_d) { + if ($opt_v) { + $NEW_VERSION = $opt_v; + } else { + my $pwd = basename(cwd()); + # The directory name should be - + my $version_chars = '0-9a-zA-Z+\.~'; + $version_chars .= ':' if defined $EPOCH; + $version_chars .= '\-' if $UVERSION ne $SVERSION; + if ($pwd =~ m/^\Q$PACKAGE\E-([0-9][$version_chars]*)$/) { + $NEW_VERSION = $1; + if ($NEW_VERSION eq $UVERSION) { + # So it's a Debian-native package + if ($SVERSION eq $UVERSION) { + fatal +"New version taken from directory ($NEW_VERSION) is equal to\n" + . "the current version number ($UVERSION)!"; + } + # So we just increment the Debian revision + warn +"$progname warning: Incrementing Debian revision without altering\nupstream version number.\n"; + $VERSION =~ /^(.*?)([a-yA-Y][a-zA-Z]*|\d*)$/; + my $end = $2; + if ($end eq '') { + fatal +"Cannot determine new Debian revision; please use -v option!"; + } + $end++; + $NEW_VERSION = "$1$end"; + } else { + $NEW_VERSION = "$EPOCH:$NEW_VERSION" if defined $EPOCH; + $NEW_VERSION .= "-1"; + } + } else { + fatal +"The directory name must be - for -d to work!\n" + . "No underscores allowed!"; + } + # Don't try renaming the directory in this case! + $opt_p = 1; + } + + if (version_compare($VERSION, $NEW_VERSION) == 1) { + if ($opt_b + or ($opt_allow_lower and $NEW_VERSION =~ /$opt_allow_lower/)) { + warn +"$progname warning: new version ($NEW_VERSION) is less than\n" + . "the current version number ($VERSION).\n"; + } else { + fatal "New version specified ($NEW_VERSION) is less than\n" + . "the current version number ($VERSION)! Use -b to force."; + } + } + + ($NEW_SVERSION = $NEW_VERSION) =~ s/^\d+://; + ($NEW_UVERSION = $NEW_SVERSION) =~ s/-[^-]*$//; + } + + # We use the following criteria for the version and release number: + # the last component of the version number is used as the + # release number. If this is not a Debian native package, then the + # upstream version number is everything up to the final '-', not + # including epochs. + + if (!$NEW_VERSION) { + if ($VERSION =~ /(.*?)([a-yA-Y][a-zA-Z]*|\d+)([+~])?$/i) { + my $extra = $3 || ''; + my $useextra = 0; + my $end = $2; + my $start = $1; + # If it's not already an NMU make it so + # otherwise we can be safe if we behave like dch -i + + if ( + ($opt_n or $opt_s) + and $vendor ne 'Ubuntu' + and $vendor ne 'Tanglu' + and ( ($VERSION eq $UVERSION and not $start =~ /\+nmu/) + or ($VERSION ne $UVERSION and not $start =~ /\.$/)) + ) { + + if ($VERSION eq $UVERSION) { + # First NMU of a Debian native package + $end .= "+nmu1"; + } else { + $end += 0.1; + } + } elsif ($opt_bn and not $start =~ /\+b/) { + $end .= "+b1"; + } elsif ($opt_qa and $start =~ /(.*?)-(\d+)\.$/) { + # Drop NMU revision when doing a QA upload + my $upstream_version = $1; + my $debian_revision = $2; + $debian_revision++; + $start = "$upstream_version-$debian_revision"; + $end = ""; + } elsif ($opt_R + and $vendor eq 'Ubuntu' + and not $start =~ /build/ + and not $start =~ /ubuntu/) { + $end .= "build1"; + } elsif ($opt_R + and $vendor eq 'Tanglu' + and not "$start$end" =~ /(b\d+)$/ + and not $start =~ /tanglu/) { + $end .= "b1"; + } elsif ($opt_bpo and not $start =~ /~bpo[0-9]+\+$/) { + # If it's not already a backport make it so + # otherwise we can be safe if we behave like dch -i + $end .= "~bpo$latest_dist+1"; + } elsif ($opt_stable and not $start =~ /\+deb\d+u/) { + $end .= "+deb${latest_dist}u1"; + } elsif ($opt_lts and not $start =~ /\+deb\d+u/) { + $end .= "+deb${lts_dist}u1"; + $guessed_dist = $dists{$lts_dist} . '-security'; + } elsif ($opt_l and not $start =~ /\Q$opt_l\E/) { + # If it's not already a local package make it so + # otherwise we can be safe if we behave like dch -i + $end .= $opt_l . "1"; + } elsif (!$opt_news) { + # Don't bump the version of a NEWS file in this case as we're + # using the version from the changelog + if ( ($opt_i or $opt_s) + and $vendor eq 'Ubuntu' + and $start !~ /(ubuntu|~ppa)(\d+\.)*$/ + and not $opt_U) { + + if ($start =~ /build/) { + # Drop buildX suffix in favor of ubuntu1 + $start =~ s/build//; + $end = ""; + } + $end .= "ubuntu1"; + } elsif (($opt_i or $opt_s) + and $vendor eq 'Tanglu' + and $start !~ /(tanglu)(\d+\.)*$/ + and not $opt_U) { + + if ("$start$end" =~ /(b\d+)$/) { + # Drop bX suffix in favor of tanglu1 + $start =~ s/b$//; + $end = ""; + } + $end .= "tanglu1"; + } else { + $end++; + } + + # Attempt to set the distribution for a stable upload correctly + # based on the version of the previous upload + if ($opt_stable || $opt_bpo || $opt_s || $opt_lts) { + my $previous_dist = $start; + $previous_dist =~ s/^.*[+~](?:deb|bpo)(\d+)(?:u\+)$/$1/; + if ( defined $previous_dist + and defined $dists{$previous_dist}) { + if ($opt_s || $opt_lts) { + $guessed_dist + = $dists{$previous_dist} . '-security'; + } elsif ($opt_bpo) { + +$guessed_dist + = $dists{$previous_dist} . '-backports'; + } elsif ($opt_stable) { + $guessed_dist = $dists{$previous_dist}; + } + } elsif ($opt_s) { + $guessed_dist = $dists{$latest_dist} . '-security'; + } elsif ($opt_lts) { + $guessed_dist = $dists{$lts_dist} . '-security'; + } else { + # Fallback to using the previous distribution + $guessed_dist = $changelog->{Distribution}; + } + } + + if ( + !( + $opt_s + or $opt_n + or $vendor eq 'Ubuntu' + or $vendor eq 'Tanglu' + ) + ) { + if ($start =~ /(.*?)-(\d+)\.$/) { + # Drop NMU revision + my $upstream_version = $1; + my $debian_revision = $2; + $debian_revision++; + $start = "$upstream_version-$debian_revision"; + $end = ""; + } + } + + if (!($opt_qa or $opt_bpo or $opt_stable or $opt_l)) { + $useextra = 1; + } + } + $NEW_VERSION = "$start$end"; + if ($useextra) { + $NEW_VERSION .= $extra; + } + ($NEW_SVERSION = $NEW_VERSION) =~ s/^\d+://; + ($NEW_UVERSION = $NEW_SVERSION) =~ s/-[^-]*$//; + } else { + fatal "Error parsing version number: $VERSION"; + } + } + + if ($NEW_VERSION eq $NEW_UVERSION and $VERSION ne $UVERSION) { + warn +"$progname warning: New package version is Debian native whilst previous version was not\n"; + } elsif ($NEW_VERSION ne $NEW_UVERSION and $VERSION eq $UVERSION) { + warn +"$progname warning: Previous package version was Debian native whilst new version is not\n" + unless $opt_n or $opt_s; + } + + if ($opt_bpo) { + $guessed_dist ||= $dists{$latest_dist} . '-backports'; + } + if ($opt_stable) { + $guessed_dist ||= $dists{$latest_dist}; + } + my $distribution + = $opt_D + || $guessed_dist + || ( + ($opt_release_heuristic eq 'changelog') + ? "UNRELEASED" + : $DISTRIBUTION + ); + + my $urgency = $opt_u; + if ($opt_news) { + $urgency ||= $CL_URGENCY; + } + $urgency ||= 'medium'; + + if ( ($opt_v or $opt_i or $opt_l or $opt_d) + and $opt_release_heuristic eq 'changelog' + and $changelog->{Distribution} eq 'UNRELEASED') { + + $merge = 1; + } else { + print O "$PACKAGE ($NEW_VERSION) $distribution; urgency=$urgency"; + print O ", binary-only=yes" if ($opt_bn); + print O "\n\n"; + if ($opt_n && !$opt_news) { + print O " * Non-maintainer upload.\n"; + $line = 1; + } elsif ($opt_bn && !$opt_news) { + my $arch = qx/dpkg-architecture -qDEB_BUILD_ARCH/; + chomp($arch); + print O +" * Binary-only non-maintainer upload for $arch; no source changes.\n"; + $line = 1; + } elsif ($opt_qa && !$opt_news) { + print O " * QA upload.\n"; + $line = 1; + } elsif ($opt_s && !$opt_news) { + if ($vendor eq 'Ubuntu' or $vendor eq 'Tanglu') { + print O " * SECURITY UPDATE:\n"; + print O " * References\n"; + } else { + print O " * Non-maintainer upload by the Security Team.\n"; + } + $line = 1; + } elsif ($opt_lts && !$opt_news) { + print O " * Non-maintainer upload by the LTS Security Team.\n"; + $line = 1; + } elsif ($opt_team && !$opt_news) { + print O " * Team upload.\n"; + $line = 1; + } elsif ($opt_bpo && !$opt_news) { + print O " * Rebuild for $guessed_dist.\n"; + $line = 1; + } + if (@closes_text or $TEXT or $EMPTY_TEXT) { + foreach (@closes_text) { format_line($_, 1); } + if (length $TEXT) { format_line($TEXT, 1); } + } elsif ($opt_news) { + print O " \n"; + } else { + print O " * \n"; + } + $line += 3; + print O "\n -- $MAINTAINER <$EMAIL> $DATE\n\n"; + + # Copy the old changelog file to the new one + local $/ = undef; + print O ; + } +} +if (($opt_r || $opt_a || $merge) && !$opt_create) { + # This means we just have to generate a new * entry in changelog + # and if a multi-developer changelog is detected, add developer names. + + $NEW_VERSION = $VERSION unless $NEW_VERSION; + $NEW_SVERSION = $SVERSION unless $NEW_SVERSION; + $NEW_UVERSION = $UVERSION unless $NEW_UVERSION; + + # Read and discard maintainer line, see who made the + # last entry, and determine whether there are existing + # multi-developer changes by the current maintainer. + $line = -1; + my ($lastmaint, $nextmaint, $maintline, $count, $lastheader, $lastdist, + $dist_indicator); + my $savedline = $line; + while () { + $line++; + # Start of existing changes by the current maintainer + if (/^ \[ \Q$MAINTAINER\E \]$/ && $opt_multimaint_merge) { + # If there's more than one such block, + # we only care about the first + $maintline ||= $line; + } elsif (/^ \[ (.*) \]$/ && defined $maintline) { + # Start of existing changes following those by the current + # maintainer + $nextmaint ||= $1; + } elsif ( +m/^\w[-+0-9a-z.]* \(([^\(\) \t]+)\)((?:\s+[-+0-9a-z.]+)+)\;\s+urgency=(\w+)/i + ) { + if (defined $lastmaint) { + $lastheader = $_; + $lastdist = $2; + $lastdist =~ s/^\s+//; + undef $lastdist if $lastdist eq "UNRELEASED"; + # Revert to our previously saved position + $line = $savedline; + last; + } else { + my $tmpver = $1; + $tmpver =~ s/^\s+//; + if ($tmpver =~ m/~bpo(\d+)\+/ && exists $dists{$1}) { + $dist_indicator = "$dists{$1}-backports"; + } + if ($tmpver =~ m/\+deb(\d+)u/ && exists $dists{$1}) { + $dist_indicator = "$dists{$1}"; + } + } + } elsif (/ \* (?:Upload to|Rebuild for) (\S+).*$/) { + ($dist_indicator = $1) =~ s/[!:.,;]$//; + chomp $dist_indicator; + } elsif (/^ --\s+([^<]+)\s+/ || /^ --\s+<(.+?)>/) { + $lastmaint = $1; + # Remember where we are so we can skip back afterwards + $savedline = $line; + } + + if (defined $maintline && !defined $nextmaint) { + $maintline++; + } + } + + # Munging of changelog for multimaintainer mode. + my $multimaint = 0; + if (!$opt_news) { + my $lastmultimaint; + + # Parse the changelog for multi-maintainer maintainer lines of + # the form [ Full Name ] and record the last of these. + while ($CHANGES =~ /.*\n^\s+\[\s+([^\]]+)\s+]\s*$/mg) { + $lastmultimaint = $1; + } + + if (( + !defined $lastmultimaint + && defined $lastmaint + && $lastmaint ne $MAINTAINER + && $opt_multimaint + ) + || (defined $lastmultimaint && $lastmultimaint ne $MAINTAINER) + || (defined $nextmaint) + ) { + $multimaint = 1; + + if (!$lastmultimaint) { + # Add a multi-maintainer header to the top of the existing + # changelog. + my $newchanges = ''; + $CHANGES =~ s/^( .+)$/ [ $lastmaint ]\n$1/m; + } + } + } + + # based on /usr/lib/dpkg/parsechangelog/debian + if ($CHANGES + =~ m/^\w[-+0-9a-z.]* \([^\(\) \t]+\)((?:\s+[-+0-9a-z.]+)+)\;\s+urgency=(\w+)/i + ) { + my $distribution = $1; + my $urgency = $2; + if ($opt_news) { + $urgency = $CL_URGENCY; + } + $distribution =~ s/^\s+//; + if ($opt_r) { + # Change the distribution from UNRELEASED for release + if ($distribution eq "UNRELEASED") { + if ($dist_indicator and not $opt_D) { + $distribution = $dist_indicator; + } elsif ($vendor eq 'Ubuntu') { + if ($opt_D) { + $distribution = $opt_D; + } else { + $distribution = get_ubuntu_devel_distro(); + } + } else { + $distribution = $opt_D || $lastdist || "unstable"; + } + } elsif ($opt_D) { + warn +"$progname warning: ignoring distribution passed to --release as changelog has already been released\n"; + } + # Set the start-line to 1, as we don't know what they want to edit + $line = 1; + } else { + $distribution = $opt_D if $opt_D; + } + $urgency = $opt_u if $opt_u; + $CHANGES + =~ s/^(\w[-+0-9a-z.]* \([^\(\) \t]+\))(?:\s+[-+0-9a-z.]+)+\;\s+urgency=\w+/$PACKAGE ($NEW_VERSION) $distribution; urgency=$urgency/i; + } else { + warn + "$progname: couldn't parse first changelog line, not touching it\n"; + $warnings++; + } + + if (defined $maintline && defined $nextmaint) { + # Output the lines up to the end of the current maintainer block + $count = 1; + $line = $maintline; + foreach (split /\n/, $CHANGES) { + print O $_ . "\n"; + $count++; + last if $count == $maintline; + } + } else { + # The first lines are as we have already found + print O $CHANGES; + } + + if (!$opt_r) { + # Add a multi-maintainer header... + if ($multimaint + and (@closes_text or $TEXT or $opt_news or !$EMPTY_TEXT)) { + # ...unless there already is one for this maintainer. + if (!defined $maintline) { + print O "\n [ $MAINTAINER ]\n"; + $line += 2; + } + } + + if (@closes_text or $TEXT) { + foreach (@closes_text) { format_line($_, 0); } + if (length $TEXT) { format_line($TEXT, 0); } + } elsif ($opt_news) { + print O "\n \n"; + $line++; + } elsif (!$EMPTY_TEXT) { + print O " * \n"; + } + } + + if (defined $count) { + # Output the remainder of the changes + $count = 1; + foreach (split /\n/, $CHANGES) { + $count++; + next unless $count > $maintline; + print O $_ . "\n"; + } + } + + if ($opt_t && $opt_a) { + print O "\n -- $changelog->{Maintainer} $changelog->{Date}\n"; + } else { + print O "\n -- $MAINTAINER <$EMAIL> $DATE\n"; + } + + if ($lastheader) { + print O "\n$lastheader"; + } + + # Copy the rest of the changelog file to new one + # Slurp the rest.... + local $/ = undef; + print O ; +} elsif ($opt_e && !$opt_create) { + # We don't do any fancy stuff with respect to versions or adding + # entries, we just update the timestamp and open the editor + + print O $CHANGES; + + if ($opt_t) { + print O "\n -- $changelog->{Maintainer} $changelog->{Date}\n"; + } else { + print O "\n -- $MAINTAINER <$EMAIL> $DATE\n"; + } + + # Copy the rest of the changelog file to the new one + $line = -1; + while () { $line++; last if /^ --/; } + # Slurp the rest... + local $/ = undef; + print O ; + + # Set the start-line to 0, as we don't know what they want to edit + $line = 0; +} elsif ($opt_create) { + if ( !$initial_release + and !$opt_news + and !$opt_empty + and !$TEXT + and !$EMPTY_TEXT) { + push @closes_text, "Initial release. (Closes: \#XXXXXX)\n"; + } + + my $urgency = $opt_u; + if ($opt_news) { + $urgency ||= $CL_URGENCY; + } + $urgency ||= 'medium'; + print O "$PACKAGE ($VERSION) $DISTRIBUTION; urgency=$urgency\n\n"; + + if (@closes_text or $TEXT) { + foreach (@closes_text) { format_line($_, 1); } + if (length $TEXT) { format_line($TEXT, 1); } + } elsif ($opt_news) { + print O " \n"; + } elsif ($opt_empty) { + # Do nothing, but skip the empty entry + } else { # this can't happen, but anyway... + print O " * \n"; + } + + print O "\n -- $MAINTAINER <$EMAIL> $DATE\n"; + + $line = 1; +} elsif (!$optionsok) { + fatal "Unknown changelog processing command line options - help!"; +} + +if (!$opt_create) { + close S or fatal "Error closing $changelog_path: $!"; +} +close O or fatal "Error closing temporary $changelog_path: $!"; + +if ($warnings) { + if ($warnings > 1) { + warn +"$progname: Did you see those $warnings warnings? Press RETURN to continue...\n"; + } else { + warn +"$progname: Did you see that warning? Press RETURN to continue...\n"; + } + my $garbage = ; +} + +# Now Run the Editor; always run if doing "closes" to give a chance to check +if ( (!$TEXT and !$EMPTY_TEXT and !($opt_create and $opt_empty)) + or @closes_text + or ($opt_create and !($PACKAGE ne 'PACKAGE' and $VERSION ne 'VERSION'))) { + + my $mtime = (stat("$changelog_path.dch"))[9]; + defined $mtime + or fatal + "Error getting modification time of temporary $changelog_path: $!"; + $mtime--; + utime $mtime, $mtime, "$changelog_path.dch"; + + system("sensible-editor +$line $changelog_path.dch") == 0 + or fatal "Error editing $changelog_path"; + + my $newmtime = (stat("$changelog_path.dch"))[9]; + defined $newmtime + or fatal + "Error getting modification time of temporary $changelog_path: $!"; + if ( $mtime == $newmtime + && !$opt_create + && (!$opt_r || ($opt_r && $opt_force_save_on_release))) { + + warn "$progname: $changelog_path unmodified; exiting.\n"; + exit 0; + } +} + +copy("$changelog_path.dch", "$changelog_path") + or fatal "Couldn't replace $changelog_path with new version: $!"; + +# Now find out what the new package version number is if we need to +# rename the directory + +if ( (basename(cwd()) =~ m%^\Q$PACKAGE\E-\Q$UVERSION\E$%) + && !$opt_p + && !$opt_create) { + # Find the current version number etc. + my $v; + my $changelog = changelog_parse(); + if (exists $changelog->{Version}) { + $v = Dpkg::Version->new($changelog->{Version}); + } + + fatal "No version number in debian/changelog!" + unless defined($v) + and $v->is_valid(); + + my ($new_version, $new_uversion); + $new_version = $v->as_string(omit_epoch => 1); + $new_uversion = $v->as_string(omit_epoch => 1, omit_revision => 1); + + if ($new_uversion ne $UVERSION) { + # Then we rename the directory + if (move(cwd(), "../$PACKAGE-$new_uversion")) { + warn +"$progname warning: your current directory has been renamed to:\n../$PACKAGE-$new_uversion\n"; + } else { + warn "$progname warning: Couldn't rename directory: $!\n"; + } + if (!$v->is_native()) { + # And check whether a new orig tarball exists + my @origs = glob("../$PACKAGE\_$new_uversion.*"); + my $num_origs = grep { +/^..\/\Q$PACKAGE\E_\Q$new_uversion\E\.orig\.tar\.$compression_re$/ + } @origs; + if ($num_origs == 0) { + warn +"$progname warning: no orig tarball found for the new version.\n"; + } + } + } +} + +exit 0; + +{ + no warnings 'uninitialized'; + # Format for standard Debian changelogs + format CHANGELOG = + * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $CHGLINE + ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $CHGLINE +. + # Format for NEWS files. + format NEWS = + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $CHGLINE +~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $CHGLINE +. +} + +my $linecount = 0; + +sub format_line { + $CHGLINE = shift; + my $newentry = shift; + + # Work around the fact that write() with formats + # seems to assume that characters are single-byte + # See https://rt.perl.org/Public/Bug/Display.html?id=33832 + # and Debian bugs #473769 and #541484 + # This relies on $CHGLINE being a sequence of unicode characters. We can + # compare how many unicode characters we have to how many bytes we have + # when encoding to utf8 and therefore how many spaces we need to pad. + my $count = length(encode_utf8($CHGLINE)) - length($CHGLINE); + $CHGLINE .= " " x $count; + + print O "\n" if $opt_news && !($newentry || $linecount); + $linecount++; + my $f = select(O); + if ($opt_news) { + $~ = 'NEWS'; + } else { + $~ = 'CHANGELOG'; + } + write O; + select $f; +} + +BEGIN { + # Initialise the variable + $tmpchk = 0; +} + +END { + if ($tmpchk) { + unlink "$changelog_path.dch" + or warn "$progname warning: Could not remove $changelog_path.dch\n"; + unlink "$changelog_path.dch~"; # emacs backup file + } +} + +sub fatal($) { + my ($pack, $file, $line); + ($pack, $file, $line) = caller(); + (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d; + $msg =~ s/\n\n$/\n/; + die $msg; +} + +# Is the environment variable valid or not? +sub check_env_utf8 { + my $envvar = $_[0]; + + if (exists $ENV{$envvar} and $ENV{$envvar} ne '') { + if (!decode_utf8($ENV{$envvar})) { + warn +"$progname warning: environment variable $envvar not UTF-8 encoded; ignoring\n"; + } else { + $env{$envvar} = decode_utf8($ENV{$envvar}); + } + } +} diff --git a/scripts/debcheckout.pl b/scripts/debcheckout.pl new file mode 100755 index 0000000..a61ce79 --- /dev/null +++ b/scripts/debcheckout.pl @@ -0,0 +1,1311 @@ +#!/usr/bin/perl +# +# debcheckout: checkout the development repository of a Debian package +# Copyright (C) 2007-2009 Stefano Zacchiroli +# Copyright (C) 2010 Christoph Berg +# +# This program 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 3 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . +# + +# Created: Tue, 14 Aug 2007 10:20:55 +0200 +# Last-Modified: $Date$ + +=head1 NAME + +debcheckout - checkout the development repository of a Debian package + +=head1 SYNOPSIS + +=over + +=item B [I] I [I] + +=item B [I] I [I] + +=item B B<--help> + +=back + +=head1 DESCRIPTION + +B retrieves the information about the Version Control System used +to maintain a given Debian package (the I argument), and then checks +out the latest (potentially unreleased) version of the package from its +repository. By default the repository is checked out to the I +directory; this can be overridden by providing the I argument. + +The information about where the repository is available is expected to be found +in B fields available in the source package record. For example, the B +package exposes such information with a field like S>, you can see it by grepping through +B. + +If more than one source package record containing B fields is available, +B will select the record with the highest version number. +Alternatively, a particular version may be selected from those available by +specifying the package name as I=I. + +If you already know the URL of a given repository you can invoke +B directly on it, but you will probably need to pass the +appropriate B<-t> flag. That is, some heuristics are in use to guess +the repository type from the URL; if they fail, you might want to +override the guessed type using B<-t>. + +The currently supported version control systems are: Arch (arch), Bazaar (bzr), CVS (cvs), +Darcs (darcs), Git (git), Mercurial (hg) and Subversion (svn). + +=head1 OPTIONS + +B + +=over + +=item B<-a>, B<--auth> + +Work in authenticated mode; this means that for known repositories (mainly those +hosted on S>) URL rewriting is attempted before +checking out, to ensure that the repository can be committed to. For example, +for Git repositories hosted on Salsa this means that +S> will be used instead of +S>. + +There are built-in rules for salsa.debian.org, alioth.debian.org and github.com. Other hosts +can be configured using B. + +=item B<-d>, B<--details> + +Only print a list of detailed information about the package +repository, without checking it out; the output format is a list of +fields, each field being a pair of TAB-separated field name and field +value. The actual fields depend on the repository type. This action +might require a network connection to the remote repository. + +Also see B<-p>. This option and B<-p> are mutually exclusive. + +=item B<-h>, B<--help> + +Print a detailed help message and exit. + +=item B<-p>, B<--print> + +Only print a summary about package repository information, without +checking it out; the output format is TAB-separated with two fields: +repository type, repository URL. This action works offline, it only +uses "static" information as known by APT's cache. + +Also see B<-d>. This option and B<-d> are mutually exclusive. + +=item B<-P> I, B<--package> I + +When checking out a repository URL, instead of trying to guess the package name +from the URL, use this package name. + +=item B<-t> I, B<--type> I + +Override the repository type (which defaults to some heuristics based +on the URL or, in case of heuristic failure, the fallback "git"); +should be one of the currently supported repository types. + +=item B<-u> I, B<--user> I + +Specify the login name to be used in authenticated mode (see B<-a>). This option +implies B<-a>: you don't need to specify both. + +=item B<-f> I, B<--file> I + +Specify that the named file should be extracted from the repository and placed +in the destination directory. May be used more than once to extract multiple +files. + +=item B<--source=never>|B|B|B + +Some packages only place the F directory in version control. +B can retrieve the remaining parts of the source using B and move the files into the checkout. + +=over + +=item B + +Only use the repository. + +=item B (default) + +If the repository only contains the F directory, retrieve the source +package, unpack it, and also place the F<.orig.tar.gz> file into the current +directory. Else, do nothing. + +=item B + +Always retrieve the I<.orig.tar.gz> file, but do not unpack it. + +=item B + +Always retrieve the I<.orig.tar.gz> file, and if the repository only contains the +F directory, unpack it. + +=back + +=back + +B + +I + +=over + +=item B<--git-track> I + +Specify a list of remote branches which will be set up for tracking +(as in S>, see B(1)) after the remote +Git repository has been cloned. The list should be given as a +space-separated list of branch names. + +As a shorthand, the string "B<*>" can be given to require tracking of all +remote branches. + +=back + +=head1 CONFIGURATION VARIABLES + +The two configuration files F and +F<~/.devscripts> are sourced by a shell in that order to set +configuration variables. Command line options can be used to override +configuration file settings. Environment variable settings are ignored +for this purpose. The currently recognised variables are: + +=over + +=item B + +This variable should be a space separated list of Perl regular +expressions and replacement texts, which must come in pairs: I +I I I ... and so on. Each pair denotes a substitution which +is applied to repository URLs if other built-in means of building URLs +for authenticated mode (see B<-a>) have failed. + +References to matching substrings in the replacement texts are +allowed as usual in Perl by the means of B<$1>, B<$2>, ... and so on. + +This setting is used to configure the "authenticated mode" location for +repositories. The Debian repositories on S are implicitly +defined, as is S. + +Here is a sample snippet suitable for the configuration files: + + DEBCHECKOUT_AUTH_URLS=' + ^\w+://(svn\.example\.com)/(.*) svn+ssh://$1/srv/svn/$2 + ^\w+://(git\.example\.com)/(.*) git+ssh://$1/home/git/$2 + ' + +Note that whitespace is not allowed in either regexps or +replacement texts. Also, given that configuration files are sourced by +a shell, you probably want to use single quotes around the value of +this variable. + +=item B + +This variable determines under what scenarios the associated orig.tar.gz for a +package will be downloaded. See the B<--source> option for a description of +the values. + +=item B + +This variable sets the username for authenticated mode. It can be overridden +with the B<--user> option. Setting this variable does not imply the use of +authenticated mode, it still has to be activated with B<--auth>. + +=back + +=head1 SEE ALSO + +B(8), Section 6.2.5 of the Debian Developer's Reference (for +more information about B fields): S>. + +=head1 AUTHOR + +B and this manpage have been written by Stefano Zacchiroli +>. + +=cut + +use strict; +use warnings; +no if $] >= 5.018, 'warnings', 'experimental::smartmatch'; +use feature 'switch'; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use Pod::Usage; +use File::Basename; +use File::Copy qw/copy/; +use File::Temp qw/tempdir/; +use Cwd; +use Devscripts::Compression; +use Devscripts::Versort; + +my @files = (); # files to checkout + +my $compression_re = compression_get_file_extension_regex(); + +# +# +my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); +my %config_vars = ( + 'DEBCHECKOUT_AUTH_URLS' => '', + 'DEBCHECKOUT_SOURCE' => 'auto', + 'DEBCHECKOUT_USER' => '', +); +my %config_default = %config_vars; +my $shell_cmd; +# Set defaults +foreach my $var (keys %config_vars) { + $shell_cmd .= qq[$var="$config_vars{$var}";\n]; +} +$shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; +$shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; +# Read back values +foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } +my $shell_out = `/bin/bash -c '$shell_cmd'`; +@config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; +# + +my $lwp_broken; +my $ua; + +sub have_lwp() { + return ($lwp_broken ? 0 : 1) if defined $lwp_broken; + eval { + require LWP; + require LWP::UserAgent; + }; + + if ($@) { + if ($@ =~ m%^Can\'t locate LWP%) { + $lwp_broken = "the libwww-perl package is not installed"; + } else { + $lwp_broken = "couldn't load LWP::UserAgent: $@"; + } + } else { + $lwp_broken = ''; + } + return $lwp_broken ? 0 : 1; +} + +sub init_agent { + $ua = new LWP::UserAgent; # we create a global UserAgent object + $ua->agent("LWP::UserAgent/Devscripts"); + $ua->env_proxy; +} + +sub recurs_mkdir { + my ($dir) = @_; + my @temp = split /\//, $dir; + my $createdir = ""; + foreach my $piece (@temp) { + if (!length $createdir and !length $piece) { + $createdir = "/"; + } elsif (length $createdir and $createdir ne "/") { + $createdir .= "/"; + } + $createdir .= "$piece"; + if (!-d $createdir) { + mkdir($createdir) or return 0; + } + } + return 1; +} + +# Find the repository URL (and type) for a given package name, parsing Vcs-* +# fields. Returns (version, type, url, origtgz_name) tuple. +sub find_repo($$) { + my ($pkg, $desired_ver) = @_; + my @repo = ("", 0, "", ""); + my $found = 0; + my ($nonepoch_version, $version) = ("", ""); + my $origtgz_name = ""; + my $type = ""; + my $url = ""; + my @repos = (); + + open(APT, "apt-cache showsrc $pkg |"); + while (my $line = ) { + $found = 1; + chomp($line); + if ($line =~ /^(x-)?vcs-(\w+):\s*(.*)$/i) { + next if lc($2) eq "browser"; + ($type, $url) = (lc($2), $3); + } elsif ($line =~ /^Version:\s*(.*)$/i) { + $version = $1; + ($nonepoch_version = $version) =~ s/^\d+://; + } elsif ($line + =~ /^ [a-f0-9]{32} \d+ (\S+)(?:_\Q$nonepoch_version\E|\.orig)\.tar\.$compression_re$/ + ) { + $origtgz_name = $1; + } elsif ($line =~ /^$/) { + push(@repos, [$version, $type, $url, $origtgz_name]) + if ( $version + and $type + and $url + and ($desired_ver eq "" or $desired_ver eq $version)); + $version = ""; + $type = ""; + $url = ""; + $origtgz_name = ""; + } + } + close(APT); + die "unknown package '$pkg'\n" unless $found; + + if (@repos) { + @repos = Devscripts::Versort::versort(@repos); + @repo = @{ $repos[0] }; + } + return @repo; +} + +# Find the browse URL for a given package name, parsing Vcs-* fields. +sub find_browse($$) { + my ($pkg, $desired_ver) = @_; + my $browse = ""; + my $found = 0; + my $version = ""; + my @browses; + + open(APT, "apt-cache showsrc $pkg |"); + while (my $line = ) { + $found = 1; + chomp($line); + if ($line =~ /^(x-)?vcs-(\w+):\s*(.*)$/i) { + if (lc($2) eq "browser") { + $browse = $3; + } + } elsif ($line =~ /^Version:\s*(.*)$/i) { + $version = $1; + } elsif ($line =~ /^$/) { + push(@browses, [$version, $browse]) + if $version + and $browse + and ($desired_ver eq "" or $desired_ver eq $version); + $version = ""; + $browse = ""; + } + } + close(APT); + die "unknown package '$pkg'\n" unless $found; + if (@browses) { + @browses = Devscripts::Versort::versort(@browses); + $browse = $browses[0][1]; + } + return $browse; +} + +# Patch the cmdline invocation of a VCS to ensure the repository is checkout to +# a given target directory. +sub set_destdir($$@) { + my ($repo_type, $destdir, @cmd) = @_; + $destdir =~ s|^-d\s*||; + + given ($repo_type) { + when ("cvs") { + my $module = pop @cmd; + push @cmd, ("-d", $destdir, $module); + } + when (/^(bzr|darcs|git|hg|svn)$/) { + push @cmd, $destdir; + } + default { + die +"sorry, don't know how to set the destination directory for $repo_type repositories (patches welcome!)\n"; + } + } + return @cmd; +} + +# try patching a repository URL to enable authenticated mode, *relying +# only on user defined rules* +sub user_set_auth($$) { + my ($repo_type, $url) = @_; + my @rules = split ' ', $config_vars{'DEBCHECKOUT_AUTH_URLS'}; + while (my $pat = shift @rules) { # read pairs for s/$pat/$subst/ + my $subst = shift @rules + or die +"Configuration error for DEBCHECKOUT_AUTH_URLS: regexp and replacement texts must come in pairs. See debcheckout(1).\n"; + $url =~ s/$pat/qq("$subst")/ee; # ZACK: my worst Perl line ever + } + return $url; +} + +# Patch a given repository URL to ensure that the checked out out repository +# can be committed to. Only works for well known repositories (mainly Salsa's). +sub set_auth($$$$) { + my ($repo_type, $url, $user, $dont_act) = @_; + + my $old_url = $url; + + $user .= "@" if length $user; + my $user_local = $user; + $user_local =~ s|(.*)(@)|$1|; + my $user_url = $url; + +# Adjust alioth urls from new-style anonymous access to old-style and then deal +# with adjusting for authentication on alioth + $url + =~ s@(?:alioth\.debian\.org/(?:anonscm/bzr|scm/loggerhead/bzr)|anonscm\.debian\.org/bzr(?:/bzr)?)@bzr.debian.org/bzr@; + $url + =~ s@(?:alioth\.debian\.org/anonscm/darcs|anonscm\.debian\.org/darcs)@darcs.debian.org/darcs@; + $url =~ s@git://anonscm\.debian\.org@git://git.debian.org@; + $url + =~ s@(?:alioth\.debian\.org/anonscm/c?git|anonscm\.debian\.org/c?git)@git.debian.org/git@; + $url + =~ s@(?:alioth\.debian\.org/anonscm/hg|anonscm\.debian\.org/hg)@hg.debian.org/hg@; + $url =~ s@svn://(?:scm\.alioth|anonscm)\.debian\.org@svn://svn.debian.org@; + + # other providers + $url =~ s!(?:git|https?)://github\.com/!git\@github.com:!; + + given ($repo_type) { + when ("bzr") { + $url + =~ s|^[\w+]+://(bzr\.debian\.org)/(.*)|bzr+ssh://$user$1/bzr/$2|; + $url + =~ s[^\w+://(?:(bazaar|code)\.)?(launchpad\.net/.*)][bzr+ssh://${user}bazaar.$2]; + } + when ("darcs") { + if ($url =~ m|(~)|) { + $user_url =~ s|^\w+://(darcs\.debian\.org)/(~)(.*?)/.*|$3|; + die +"the local user '$user_local' doesn't own the personal repository '$url'\n" + if $user_local ne $user_url and !$dont_act; + $url + =~ s|^\w+://(darcs\.debian\.org)/(~)(.*?)/(.*)|$user$1:~/public_darcs/$4|; + } else { + $url + =~ s|^\w+://(darcs\.debian\.org)/(?:darcs/)?(.*)|$user$1:/darcs/$2|; + } + } + when ("git") { + if ($url =~ s!^https://salsa.debian.org/!git\@salsa.debian.org:!) { + } elsif ($url =~ m%(/users/|~)%) { + $user_url + =~ s|^\w+://(git\.debian\.org)/git/users/(.*?)/.*|$2|; + $user_url =~ s|^\w+://(git\.debian\.org)/~(.*?)/.*|$2|; + + die +"the local user '$user_local' doesn't own the personal repository '$url'\n" + if $user_local ne $user_url and !$dont_act; + $url + =~ s|^\w+://(git\.debian\.org)/git/users/.*?/(.*)|git+ssh://$user$1/~/public_git/$2|; + $url + =~ s|^\w+://(git\.debian\.org)/~.*?/(.*)|git+ssh://$user$1/~/public_git/$2|; + } else { + $url + =~ s|^\w+://(git\.debian\.org)/(?:git/)?(.*)|git+ssh://$user$1/git/$2|; + } + $url + =~ s[^\w+://(?:(git|code)\.)?(launchpad\.net/.*)][git+ssh://${user}git.$2]; + } + # "hg ssh://" needs an extra slash so paths are not based in the user's $HOME + when ("hg") { + $url =~ s|^\w+://(hg\.debian\.org/)|ssh://$user$1/|; + } + when ("svn") { + $url =~ s|^\w+://(svn\.debian\.org)/(.*)|svn+ssh://$user$1/svn/$2|; + } + default { + die +"sorry, don't know how to enable authentication for $repo_type repositories (patches welcome!)\n"; + } + } + if ($url eq $old_url) { # last attempt: try with user-defined rules + $url = user_set_auth($repo_type, $url); + } + die +"can't use authenticated mode on repository '$url' since it is not a known repository (e.g. salsa.debian.org)\n" + if $url eq $old_url; + return $url; +} + +# Hack around specific, known deficiencies in repositories that don't follow +# standard behavior. +sub munge_url($$) { + my ($repo_type, $repo_url) = @_; + + given ($repo_type) { + when ('bzr') { + # bzr.d.o explicitly doesn't run a smart server. Need to use nosmart + $repo_url + =~ s|^http://(bzr\.debian\.org)/(.*)|nosmart+http://$1/$2|; + } + } + return $repo_url; +} + +# returns an error code after system(). If system() exited normally, this is the +# error code of the child process. If it exited with a signal (if a user hit +# C-c, say) then this returns something <0. In either case, errorcode()==0 means +# "success" +sub errorcode { + my $code = $? >> 8; + if ($code == 0 && $? != 0) { + return -$?; + } + return $code; +} + +# Checkout a given repository in a given destination directory. +sub checkout_repo($$$$) { + my ($repo_type, $repo_url, $destdir, $anon_repo_url) = @_; + my (@cmd, @extracmd); + + given ($repo_type) { + when ("arch") { @cmd = ("tla", "grab", $repo_url); } # XXX ??? + when ("bzr") { @cmd = ("bzr", "branch", $repo_url); } + when ("cvs") { + $repo_url =~ s|^-d\s*||; + my ($root, $module) = split /\s+/, $repo_url; + $module ||= ''; + @cmd = ("cvs", "-d", $root, "checkout", $module); + } + when ("darcs") { @cmd = ("darcs", "get", $repo_url); } + when ("git") { + my $push_url; + + if (defined $anon_repo_url and length $anon_repo_url) { + if ($repo_url =~ m|(.*)\s+-b\s+(.*)|) { + $push_url = $1; + } else { + $push_url = $repo_url; + } + + $repo_url = $anon_repo_url; + } + + if ($repo_url =~ m|(.*)\s+-b\s+(.*)|) { + @cmd = ("git", "clone", $1, "-b", $2); + } else { + @cmd = ("git", "clone", $repo_url); + } + + if ($push_url) { + @extracmd = ('git', 'remote', 'set-url', '--push', 'origin', + $push_url); + } + } + when ("hg") { @cmd = ("hg", "clone", $repo_url); } + when ("svn") { @cmd = ("svn", "co", $repo_url); } + default { die "unsupported version control system '$repo_type'.\n"; } + } + @cmd = set_destdir($repo_type, $destdir, @cmd) if length $destdir; + print "@cmd ...\n"; + system @cmd; + my $rc = errorcode(); + + if ($rc == 0 && @extracmd) { + my $oldcwd = getcwd(); + my $clonedir; + + print "@extracmd ...\n"; + + if (length $destdir) { + $clonedir = $destdir; + } else { + ($clonedir = $repo_url) =~ s|.*/(.*)(.git)?|$1|; + } + + chdir $clonedir; + system @extracmd; + $rc = errorcode(); + chdir($oldcwd); + } + + return $rc; +} + +# Checkout a given set of files from a given repository in a given +# destination directory. +sub checkout_files($$$$) { + my ($repo_type, $repo_url, $destdir, $browse_url) = @_; + my @cmd; + my $tempdir; + + foreach my $file (@files) { + my $fetched = 0; + + # Cheap'n'dirty escaping + # We should possibly depend on URI::Escape, but this should do... + my $escaped_file = $file; + $escaped_file =~ s|\+|%2B|g; + + my $dir; + if (defined $destdir and length $destdir) { + $dir = "$destdir/"; + } else { + $dir = "./"; + } + $dir .= dirname($file); + + if (!recurs_mkdir($dir)) { + print STDERR "Failed to create directory $dir\n"; + return 1; + } + + given ($repo_type) { + when ("arch") { + # If we've already retrieved a copy of the repository, + # reuse it + if (!length($tempdir)) { + if ( + !( + $tempdir = tempdir( + "debcheckoutXXXX", + TMPDIR => 1, + CLEANUP => 1 + )) + ) { + print STDERR + "Failed to create temporary directory . $!\n"; + return 1; + } + + my $oldcwd = getcwd(); + chdir $tempdir; + @cmd = ("tla", "grab", $repo_url); + print "@cmd ...\n"; + my $rc = system(@cmd); + chdir $oldcwd; + return ($rc >> 8) if $rc != 0; + } + + if (!copy("$tempdir/$file", $dir)) { + print STDERR "Failed to copy $file to $dir: $!\n"; + return 1; + } + } + when ("cvs") { + if (!length($tempdir)) { + if ( + !( + $tempdir = tempdir( + "debcheckoutXXXX", + TMPDIR => 1, + CLEANUP => 1 + )) + ) { + print STDERR + "Failed to create temporary directory . $!\n"; + return 1; + } + } + $repo_url =~ s|^-d\s*||; + my ($root, $module) = split /\s+/, $repo_url; + # If an explicit module name isn't present, use the last + # component of the URL + if (!length($module)) { + $module = $repo_url; + $module =~ s%^.*/(.*?)$%$1%; + } + $module .= "/$file"; + $module =~ s%//%/%g; + + my $oldcwd = getcwd(); + chdir $tempdir; + @cmd = ("cvs", "-d", $root, "export", "-r", "HEAD", "-f", + $module); + print "\n@cmd ...\n"; + system @cmd; + if (errorcode() != 0) { + chdir $oldcwd; + return (errorcode()); + } else { + chdir $oldcwd; + if (copy("$tempdir/$module", $dir)) { + print "Copied to $destdir/$file\n"; + } else { + print STDERR "Failed to copy $file to $dir: $!\n"; + return 1; + } + } + } + when (/(svn|bzr)/) { + @cmd = ($repo_type, "cat", "$repo_url/$file"); + print "@cmd > $dir/" . basename($file) . " ... \n"; + if (!open CAT, '-|', @cmd) { + print STDERR "Failed to execute @cmd $!\n"; + return 1; + } + local $/; + my $content = ; + close CAT; + if (!open OUTPUT, ">", $dir . "/" . basename($file)) { + print STDERR "Failed to create output file " + . basename($file) . " $!\n"; + return 1; + } + print OUTPUT $content; + close OUTPUT; + } + when (/(darcs|hg)/) { + # Subtly different but close enough + if (have_lwp) { + print "Attempting to retrieve $file via HTTP ...\n"; + + my $file_url + = $repo_type eq "darcs" + ? "$repo_url/$escaped_file" + : "$repo_url/raw-file/tip/$file"; + init_agent() unless $ua; + my $request = HTTP::Request->new('GET', "$file_url"); + my $response = $ua->request($request); + if ($response->is_success) { + if (!open OUTPUT, ">", $dir . "/" . basename($file)) { + print STDERR "Failed to create output file " + . basename($file) . " $!\n"; + return 1; + } + print "Writing to $dir/" . basename($file) . " ... \n"; + print OUTPUT $response->content; + close OUTPUT; + $fetched = 1; + } + } + if ($fetched == 0) { + # If we've already retrieved a copy of the repository, + # reuse it + if (!length($tempdir)) { + if ( + !( + $tempdir = tempdir( + "debcheckoutXXXX", + TMPDIR => 1, + CLEANUP => 1 + )) + ) { + print STDERR + "Failed to create temporary directory . $!\n"; + return 1; + } + + # Can't get / clone in to a directory that already exists... + $tempdir .= "/repo"; + if ($repo_type eq "darcs") { + @cmd = ("darcs", "get", $repo_url, $tempdir); + } else { + @cmd = ("hg", "clone", $repo_url, $tempdir); + } + print "@cmd ...\n"; + my $rc = system(@cmd); + return ($rc >> 8) if $rc != 0; + print "\n"; + } + } + if (copy "$tempdir/$file", $dir) { + print "Copied $file to $dir\n"; + } else { + print STDERR "Failed to copy $file to $dir: $!\n"; + return 1; + } + } + when ("git") { + # If there isn't a browse URL (either because the package + # doesn't ship one, or because we were called with a URL, + # try a common pattern for gitweb + if (!length($browse_url)) { + if ($repo_url =~ m%^\w+://([^/]+)/(?:git/)?(.*)$%) { + $browse_url = "http://$1/?p=$2"; + } + } + if (have_lwp and $browse_url =~ /^http/) { + $escaped_file =~ s|/|%2F|g; + + print "Attempting to retrieve $file via HTTP ...\n"; + + init_agent() unless $ua; + my $file_url = "$browse_url;a=blob_plain"; + $file_url .= ";f=$escaped_file;hb=HEAD"; + my $request = HTTP::Request->new('GET', $file_url); + my $response = $ua->request($request); + my $error = 0; + if (!$response->is_success) { + if ($browse_url =~ /\.git$/) { + print "Error retrieving file: " + . $response->status_line . "\n"; + $error = 1; + } else { + $browse_url .= ".git"; + $file_url = "$browse_url;a=blob_plain"; + $file_url .= ";f=$escaped_file;hb=HEAD"; + $request = HTTP::Request->new('GET', $file_url); + $response = $ua->request($request); + if (!$response->is_success) { + print "Error retrieving file: " + . $response->status_line . "\n"; + $error = 1; + } + } + } + if (!$error) { + if (!open OUTPUT, ">", $dir . "/" . basename($file)) { + print STDERR "Failed to create output file " + . basename($file) . " $!\n"; + return 1; + } + print "Writing to $dir/" . basename($file) . " ... \n"; + print OUTPUT $response->content; + close OUTPUT; + $fetched = 1; + } + } + if ($fetched == 0) { + # If we've already retrieved a copy of the repository, + # reuse it + if (!length($tempdir)) { + if ( + !( + $tempdir = tempdir( + "debcheckoutXXXX", + TMPDIR => 1, + CLEANUP => 1 + )) + ) { + print STDERR + "Failed to create temporary directory . $!\n"; + return 1; + } + # Since git won't clone in to a directory that + # already exists... + $tempdir .= "/repo"; + # Can't shallow clone from an http:: URL + $repo_url =~ s/^http/git/; + @cmd = ( + "git", "clone", "--depth", "1", $repo_url, + "$tempdir" + ); + print "@cmd ...\n\n"; + my $rc = system(@cmd); + return ($rc >> 8) if $rc != 0; + print "\n"; + } + + my $oldcwd = getcwd(); + chdir $tempdir; + + @cmd = ($repo_type, "show", "HEAD:$file"); + print "@cmd ... > $dir/" . basename($file) . "\n"; + if (!open CAT, '-|', @cmd) { + print STDERR "Failed to execute @cmd $!\n"; + chdir $oldcwd; + return 1; + } + chdir $oldcwd; + local $/; + my $content = ; + close CAT; + if (!open OUTPUT, ">", $dir . "/" . basename($file)) { + print STDERR "Failed to create output file " + . basename($file) . " $!\n"; + return 1; + } + print OUTPUT $content; + close OUTPUT; + } + } + default { + die "unsupported version control system '$repo_type'.\n"; + } + } + } + + # If we've got this far, all the files were retrieved successfully + return 0; +} + +# download source package, unpack it, and merge its contents into the checkout +sub unpack_source($$$$$) { + my ($pkg, $version, $destdir, $origtgz_name, $unpack_source) = @_; + + return 1 if ($unpack_source eq 'never'); + return 1 + if (defined $origtgz_name and $origtgz_name eq '') + ; # only really relevant with URL on command line + + $destdir ||= $pkg; + # Apt will auto-resolve binary package names to source package names. We + # need to know the source package name to correctly identify the source + # package artifacts (dsc, orig.tar.*, etc) + (my $srcpkg = $origtgz_name) =~ s/_.*//; + # is this a debian-dir-only repository? + unless (-d $destdir) { + print STDERR +"debcheckout did not create the $destdir directory - this is probably a bug\n"; + return 0; + } + my @repo_files = glob "$destdir/*"; + my $debian_only = 0; + if (@repo_files == 1 and $repo_files[0] eq "$destdir/debian") { + $debian_only = 1; + } + + return 1 if ($unpack_source eq 'auto' and not $debian_only); + if ($unpack_source ne 'download-only' and $debian_only) { + print +"repository only contains the debian directory, using apt-get source\n"; + } + + my $tmpdir = File::Temp->newdir(DIR => "."); + + # unpack + my $oldcwd = getcwd(); + chdir $tmpdir; + my @args = ('source'); + push @args, '--download-only' + if ($unpack_source eq 'download-only' or not $debian_only); + push @args, $version ? "$srcpkg=$version" : $srcpkg; + system('apt-get', @args); + chdir $oldcwd; + + if (errorcode()) { + print STDERR "apt-get source failed\n"; + return 0; + } + + # put source package in place + foreach my $sourcefile (glob "$tmpdir/${srcpkg}_*") { + next unless (-f $sourcefile); # skip directories + my $base = $sourcefile; + $base =~ s!.*/!!; + rename $sourcefile, $base or die "rename $sourcefile $base: $!"; + } + + return 1 if ($unpack_source eq 'download-only' or not $debian_only); + + # figure out which directory was created + my @dirs = glob "$tmpdir/$srcpkg-*/"; + unless (@dirs) { + print STDERR + "apt-get source did not create any $tmpdir/$srcpkg-* directory\n"; + return 0; + } + my $directory = $dirs[0]; + chop $directory; + + # move all files over, except the debian directory + opendir DIR, $directory or die "opendir $directory: $!"; + foreach my $file (readdir DIR) { + if ($file eq 'debian') { + system('rm', '-rf', "$directory/$file"); + } elsif ($file eq '.' or $file eq '..') { + next; + } else { + rename "$directory/$file", "$destdir/$file" + or die "rename $directory/$file $destdir/$file: $!"; + } + } + closedir DIR; + rmdir $directory or die "rmdir $directory: $!"; + + # $tmpdir is automatically removed + return 1; +} + +# Print information about a repository and quit. +sub print_repo($$) { + my ($repo_type, $repo_url) = @_; + + print "$repo_type\t$repo_url\n"; + exit(0); +} + +sub git_ls_remote($$) { + my ($url, $prefix) = @_; + + $url =~ s|\s+-b\s+.*||; + my $cmd = "git ls-remote '$url'"; + $cmd .= " '$prefix/*'" if length $prefix; + open GIT, "$cmd |" or die "can't execute $cmd\n"; + my @refs; + while (my $line = ) { + chomp $line; + my ($sha1, $name) = split /\s+/, $line; + my $ref = $name; + $ref = substr($ref, length($prefix) + 1) if length $prefix; + push @refs, $ref; + } + close GIT; + return @refs; +} + +# Given a GIT repository URL, extract its topgit info (if any), see +# the "topgit" package for more information +sub tg_info($) { + my ($url) = @_; + + my %info; + $info{'topgit'} = 'no'; + $info{'top-bases'} = ''; + my @bases = git_ls_remote($url, 'refs/top-bases'); + if (@bases) { + $info{'topgit'} = 'yes'; + $info{'top-bases'} = join ' ', @bases; + } + return (\%info); +} + +# Print details about a repository and quit. +sub print_details($$) { + my ($repo_type, $repo_url) = @_; + + print "type\t$repo_type\n"; + print "url\t$repo_url\n"; + if ($repo_type eq "git") { + my $tg_info = tg_info($repo_url); + while (my ($k, $v) = each %$tg_info) { + print "$k\t$v\n"; + } + } + exit(0); +} + +sub guess_repo_type($$) { + my ($repo_url, $default) = @_; + my $repo_type = $default; + if ($repo_url =~ /^(git|svn|bzr)(\+ssh)?:/) { + $repo_type = $1; + } elsif ($repo_url =~ /^https?:\/\/(svn|git|hg|bzr|darcs)\.debian\.org/) { + $repo_type = $1; + } elsif ( + $repo_url =~ m@^https?://anonscm.debian.org/(svn|c?git|hg|bzr|darcs)/@) + { + $repo_type = $1; + $repo_type =~ s/cgit/git/; + } + return $repo_type; +} + +# Does a given string match the lexical rules for package names? +sub is_package($) { + my ($arg) = @_; + + return ($arg =~ /^[a-z0-9.+-]+$/); # lexical rule for package names +} + +sub main() { + my $auth = 0; # authenticated mode + my $destdir = ""; # destination directory + my $pkg = ""; # package name + my $version = ""; # package version + my $origtgz_name + = undef; # orig.tar.gz name (or "" when none; undef means unknown) + my $print_mode = 0; # print only mode + my $details_mode = 0; # details only mode + my $use_package = ''; # use this package instead of guessing from the URL + my $repo_type = "git"; # default repo typo, overridden by '-t' + my $repo_url = ""; # repository URL + my $anon_repo_url; # repository URL (before auth mangling) + my $user = ""; # login name (authenticated mode only) + my $browse_url = ""; # online browsable repository URL + my $git_track = ""; # list of remote GIT branches to --track + my $unpack_source + = $config_vars{DEBCHECKOUT_SOURCE}; # retrieve and unpack orig.tar.gz + GetOptions( + "auth|a" => \$auth, + "help|h" => sub { pod2usage({ -exitval => 0, -verbose => 1 }); }, + "print|p" => \$print_mode, + "details|d" => \$details_mode, + "package|P=s" => \$use_package, + "type|t=s" => \$repo_type, + "user|u=s" => \$user, + "file|f=s" => sub { push(@files, $_[1]); }, + "git-track=s" => \$git_track, + "source=s" => \$unpack_source, + ) or pod2usage({ -exitval => 3 }); + pod2usage({ -exitval => 3 }) if ($#ARGV < 0 or $#ARGV > 1); + pod2usage({ + -exitval => 3, + -message => "-d and -p are mutually exclusive.\n", + }) if ($print_mode and $details_mode); + my $dont_act = 1 if ($print_mode or $details_mode); + pod2usage({ + -exitval => 3, + -message => +"--source argument must be one of never, auto, download-only, and always\n", + }) unless ($unpack_source =~ /^(never|auto|download-only|always)$/); + + # -u|--user implies -a|--auth + $auth = 1 if length $user; + + # set user from the config file to be used with -a|--auth without -u|--user + $user = $config_vars{DEBCHECKOUT_USER} unless $user; + + $destdir = $ARGV[1] if $#ARGV > 0; + ($pkg, $version) = split(/=/, $ARGV[0]); + $version ||= ""; + + if (not is_package($pkg)) { # repo-url passed on the command line + $repo_url = $ARGV[0]; + $repo_type = guess_repo_type($repo_url, $repo_type); + $pkg = ""; + $version = ""; + # when --package is given, use it + if ($use_package) { + $pkg = $use_package; + # else guess package from url + } elsif ($repo_url =~ m!/trunk/([a-z0-9.+-]+)!) + { # svn with {trunk,tags,branches}/$pkg + $pkg = $1; + } elsif ($repo_url =~ m!([a-z0-9.+-]+)/trunk/?!) + { # svn with $pkg/{trunk,tags,branches} + $pkg = $1; + } elsif ($repo_url =~ /([a-z0-9.+-]+)\.git(\s+-b\s+.*)?$/) { # git + $pkg = $1; + } elsif ($repo_url =~ /([a-z0-9.+-]+)$/) { # catch-all + $pkg = $1; + } + $origtgz_name = $pkg + ; # FIXME: this should rather set srcpkg in unpack_source() directly + } else { # package name passed on the command line + ($version, $repo_type, $repo_url, $origtgz_name) + = find_repo($pkg, $version); + unless ($repo_type) { + my $vermsg = ""; + $vermsg = ", version $version" if length $version; + print <>', "$destdir/.bzr/branch/branch.conf") { + print B "\npush_location = $repo_url"; + close B; + } else { + print STDERR + "failed to open branch.conf to add push_location: $!\n"; + } + } elsif ($repo_type eq 'git') { + my $tg_info = tg_info($repo_url); + my $wcdir = $destdir; + # HACK: if $destdir is unknown, take last URL part and remove /.git$/ + $wcdir = (split m|\.|, (split m|/|, $repo_url)[-1])[0] + unless length $wcdir; + if ($$tg_info{'topgit'} eq 'yes') { + print "TopGit detected, populating top-bases ...\n"; + system("cd $wcdir && tg remote --populate origin"); + $rc = errorcode(); + print STDERR "TopGit population failed\n" if $rc != 0; + } + system("cd $wcdir && git config user.name \"$ENV{'DEBFULLNAME'}\"") + if (defined($ENV{'DEBFULLNAME'})); + system("cd $wcdir && git config user.email \"$ENV{'DEBEMAIL'}\"") + if (defined($ENV{'DEBEMAIL'})); + if (length $git_track) { + my @heads; + if ($git_track eq '*') { + @heads = git_ls_remote($repo_url, 'refs/heads'); + } else { + @heads = split ' ', $git_track; + } + # Filter out any branches already populated via TopGit + my @tgheads = split ' ', $$tg_info{'top-bases'}; + my $master = 'master'; + if ( + open(HEAD, + "env GIT_DIR=\"$wcdir/.git\" git symbolic-ref HEAD |" + ) + ) { + $master = ; + chomp $master; + $master =~ s@refs/heads/@@; + } + close(HEAD); + foreach my $head (@heads) { + next if $head eq $master; + next if grep { $head eq $_ } @tgheads; + my $cmd = "cd $wcdir"; + $cmd .= " && git branch --track $head remotes/origin/$head"; + system($cmd); + } + } + } elsif ($repo_type eq 'hg') { + my $username = ''; + $username .= " $ENV{'DEBFULLNAME'}" if (defined($ENV{'DEBFULLNAME'})); + $username .= " <$ENV{'DEBEMAIL'}>" if (defined($ENV{'DEBEMAIL'})); + if ($username) { + if (open(HGRC, '>>', "$destdir/.hg/hgrc")) { + print HGRC "[ui]\nusername =$username\n"; + close HGRC; + } else { + print STDERR "failed to open hgrc to set username: $!\n"; + } + } + } + die "post-checkout action failed\n" + if $rc != 0; + + if ($unpack_source) { + unless ($pkg) { + print STDERR + "could not determine package name for orig.tar.gz retrieval\n"; + $rc ||= 1; + exit($rc); + } + unpack_source($pkg, $version, $destdir, $origtgz_name, $unpack_source) + or $rc = 1; + } + + exit($rc); +} + +main(); + +# vim:sw=4 diff --git a/scripts/debclean.1 b/scripts/debclean.1 new file mode 100644 index 0000000..68fc913 --- /dev/null +++ b/scripts/debclean.1 @@ -0,0 +1,115 @@ +.TH DEBCLEAN 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debclean \- clean up a sourcecode tree +.SH SYNOPSIS +\fBdebclean\fR [\fIoptions\fR] +.SH DESCRIPTION +\fBdebclean\fR walks through the directory tree starting at the +directory tree in which it was invoked, and executes +.I debuild -- clean +for each Debian source directory encountered. These directories are +recognised by containing a debian/changelog file for a package whose +name matches that of the directory. Name matching is described below. +.PP +If \fBdebclean\fR is invoked from a directory that is already a Debian source +package, it will not descend into its subdirectories. +.PP +Also, if the \fB\-\-cleandebs\fR option is given, then in every +directory containing a Debian source tree, all files named *.deb, +*.changes and *.build are removed. The .dsc, .diff.gz and +the (.orig).tar.gz files are not touched so that the release can be +reconstructed if necessary, and the .upload files are left so that +\fBdebchange\fR functions correctly. The \fB\-\-nocleandebs\fR option +prevents this extra cleaning behaviour and the \fB\-\-cleandebs\fR +option forces it. The default is not to clean these files. +.PP +\fBdebclean\fR uses \fBdebuild\fR(1) to clean the source tree. +.SH "Directory name checking" +In common with several other scripts in the \fBdevscripts\fR package, +\fBdebclean\fR will walk through the directory tree searching for +\fIdebian/changelog\fR files. As a safeguard against stray files +causing potential problems, it will examine the name of the parent +directory once it finds a \fIdebian/changelog\fR file, and check +that the directory name corresponds to the package name. Precisely +how it does this is controlled by two configuration file variables +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR and \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR, and +their corresponding command-line options \fB\-\-check-dirname-level\fR +and \fB\-\-check-dirname-regex\fR. +.PP +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR can take the following values: +.TP +.B 0 +Never check the directory name. +.TP +.B 1 +Only check the directory name if we have had to change directory in +our search for \fIdebian/changelog\fR. This is the default behaviour. +.TP +.B 2 +Always check the directory name. +.PP +The directory name is checked by testing whether the current directory +name (as determined by \fBpwd\fR(1)) matches the regex given by the +configuration file option \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR or by the +command line option \fB\-\-check-dirname-regex\fR \fIregex\fR. Here +\fIregex\fR is a Perl regex (see \fBperlre\fR(3perl)), which will be +anchored at the beginning and the end. If \fIregex\fR contains a '/', +then it must match the full directory path. If not, then it must +match the full directory name. If \fIregex\fR contains the string +\'PACKAGE', this will be replaced by the source package name, as +determined from the changelog. The default value for the regex is: +\'PACKAGE(-.+)?', thus matching directory names such as PACKAGE and +PACKAGE-version. +.SH OPTIONS +.TP +.B \-\-cleandebs +Also remove all .deb, .changes and .build files from the parent +directory. +.TP +.B \-\-nocleandebs +Do not remove the .deb, .changes and .build files from the parent +directory; this is the default behaviour. +.TP +\fB\-\-check-dirname-level\fR \fIN\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-check-dirname-regex\fR \fIregex\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +.B \-d +Do not run dpkg-checkbuilddeps to check build dependencies. +.TP +.B \-\-help +Display a help message and exit successfully. +.TP +.B \-\-version +Display version and copyright information and exit successfully. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced in that order to set configuration +variables. Command line options can be used to override configuration +file settings. Environment variable settings are ignored for this +purpose. The currently recognised variables are: +.TP +.B DEBCLEAN_CLEANDEBS +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-cleandebs\fR command line parameter being used. +.TP +.BR DEVSCRIPTS_CHECK_DIRNAME_LEVEL ", " DEVSCRIPTS_CHECK_DIRNAME_REGEX +See the above section \fBDirectory name checking\fR for an explanation of +these variables. Note that these are package-wide configuration +variables, and will therefore affect all \fBdevscripts\fR scripts +which check their value, as described in their respective manpages and +in \fBdevscripts.conf\fR(5). +.SH "SEE ALSO" +.BR debuild (1), +.BR devscripts.conf (5) +.SH AUTHOR +Christoph Lameter ; +modifications by Julian Gilbey . diff --git a/scripts/debclean.sh b/scripts/debclean.sh new file mode 100755 index 0000000..200bf89 --- /dev/null +++ b/scripts/debclean.sh @@ -0,0 +1,218 @@ +#!/bin/bash + +set -e + +PROGNAME=`basename $0` +MODIFIED_CONF_MSG='Default settings modified by devscripts configuration files:' + +usage () { + echo \ +"Usage: $PROGNAME [options] + Clean all debian build trees under current directory. + + Options: + --cleandebs Also remove all .deb, .changes and .build + files from the parent of each build tree + + --nocleandebs Don't remove the .deb etc. files (default) + + --check-dirname-level N + How much to check directory names before cleaning trees: + N=0 never + N=1 only if program changes directory (default) + N=2 always + + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + + --no-conf, --noconf + Do not read devscripts config files; + must be the first option given + + -d Do not run dpkg-checkbuilddeps to check build dependencies + + --help Display this help message and exit + + --version Display version information + +$MODIFIED_CONF_MSG" +} + +version () { + echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999 by Julian Gilbey, all rights reserved. +Original code by Christoph Lameter. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later." +} + +# Boilerplate: set config variables +DEFAULT_DEBCLEAN_CLEANDEBS=no +DEFAULT_DEVSCRIPTS_CHECK_DIRNAME_LEVEL=1 +DEFAULT_DEVSCRIPTS_CHECK_DIRNAME_REGEX='PACKAGE(-.+)?' +VARS="DEBCLEAN_CLEANDEBS DEVSCRIPTS_CHECK_DIRNAME_LEVEL DEVSCRIPTS_CHECK_DIRNAME_REGEX" + + +if [ "$1" = "--no-conf" -o "$1" = "--noconf" ]; then + shift + MODIFIED_CONF_MSG="$MODIFIED_CONF_MSG + (no configuration files read)" + + # set defaults + for var in $VARS; do + eval "$var=\$DEFAULT_$var" + done +else + # Run in a subshell for protection against accidental errors + # in the config files + eval $( + set +e + for var in $VARS; do + eval "$var=\$DEFAULT_$var" + done + + for file in /etc/devscripts.conf ~/.devscripts + do + [ -r $file ] && . $file + done + + set | grep -E '^(DEBCLEAN|DEVSCRIPTS)_') + + # check sanity + case "$DEBCLEAN_CLEANDEBS" in + yes|no) ;; + *) DEBCLEAN_CLEANDEBS=no ;; + esac + case "$DEVSCRIPTS_CHECK_DIRNAME_LEVEL" in + 0|1|2) ;; + *) DEVSCRIPTS_CHECK_DIRNAME_LEVEL=1 ;; + esac + + # set config message + MODIFIED_CONF='' + for var in $VARS; do + eval "if [ \"\$$var\" != \"\$DEFAULT_$var\" ]; then + MODIFIED_CONF_MSG=\"\$MODIFIED_CONF_MSG + $var=\$$var\"; + MODIFIED_CONF=yes; + fi" + done + + if [ -z "$MODIFIED_CONF" ]; then + MODIFIED_CONF_MSG="$MODIFIED_CONF_MSG + (none)" + fi +fi + +# synonyms +CHECK_DIRNAME_LEVEL="$DEVSCRIPTS_CHECK_DIRNAME_LEVEL" +CHECK_DIRNAME_REGEX="$DEVSCRIPTS_CHECK_DIRNAME_REGEX" + +# Need -o option to getopt or else it doesn't work +TEMP=$(getopt -s bash -o "" -o d \ + --long cleandebs,nocleandebs,no-cleandebs \ + --long no-conf,noconf \ + --long check-dirname-level:,check-dirname-regex: \ + --long help,version -n "$PROGNAME" -- "$@") +if [ $? != 0 ] ; then exit 1 ; fi + +eval set -- $TEMP + +# Process Parameters +while [ "$1" ]; do + case $1 in + --cleandebs) DEBCLEAN_CLEANDEBS=yes ;; + --nocleandebs|--no-cleandebs) DEBCLEAN_CLEANDEBS=no ;; + --check-dirname-level) + shift + case "$1" in + 0|1|2) CHECK_DIRNAME_LEVEL=$1 ;; + *) echo "$PROGNAME: unrecognised --check-dirname-level value (allowed are 0,1,2)" >&2 + exit 1 ;; + esac + ;; + -d) + CHECKBUILDDEP="-d" ;; + --check-dirname-regex) + shift; CHECK_DIRNAME_REGEX="$1" ;; + --no-conf|--noconf) + echo "$PROGNAME: $1 is only acceptable as the first command-line option!" >&2 + exit 1 ;; + --help) usage; exit 0 ;; + --version) version; exit 0 ;; + --) shift; break ;; + *) echo "$PROGNAME: bug in option parser, sorry!" >&2 ; exit 1 ;; + esac + shift +done + +# Still going? +if [ $# -gt 0 ]; then + echo "$PROGNAME takes no non-option arguments;" >&2 + echo "try $PROGNAME --help for usage information" >&2 + exit 1 +fi + + +# Script to clean up debian directories + +OPWD="`pwd`" + +TESTDIR=$(echo $OPWD | grep -Eo '.*/debian/?' | sed 's/\/debian\/\?$//') + +if [ -f debian/changelog ]; then + directories=$OPWD +elif [ -f "$TESTDIR/debian/changelog" ]; then + directories=$TESTDIR +else + directories=$(find . -type d -name "debian" -a ! -wholename '*.git*/debian') +fi + +for i in $directories; do + ( # subshell to not lose where we are + DIR=${i%/debian} + echo "Cleaning in directory $DIR" + cd $DIR + + # Clean up the source package, but only if the directory looks like + # a genuine build tree + if [ ! -f debian/changelog ]; then + echo "Directory $DIR: contains no debian/changelog, skipping" >&2 + exit + fi + package="`dpkg-parsechangelog -SSource`" + if [ -z "$package" ]; then + echo "Directory $DIR: unable to determine package name, skipping" >&2 + exit + fi + + # let's test the directory name if appropriate + if [ $CHECK_DIRNAME_LEVEL -eq 2 -o \ + \( $CHECK_DIRNAME_LEVEL -eq 1 -a "$OPWD" != "`pwd`" \) ]; then + if ! perl -MFile::Basename -w \ + -e "\$pkg='$package'; \$re='$CHECK_DIRNAME_REGEX';" \ + -e '$re =~ s/PACKAGE/\\Q$pkg\\E/g; $pwd=`pwd`; chomp $pwd;' \ + -e 'if ($re =~ m%/%) { eval "exit (\$pwd =~ /^$re\$/ ? 0:1);"; }' \ + -e 'else { eval "exit (basename(\$pwd) =~ /^$re\$/ ? 0:1);"; }' + then + echo "Full directory path `pwd` does not match package name, skipping." >&2 + echo "Run $progname --help for more information on directory name matching." >&2 + exit + fi + fi + + # We now know we're OK and debuild won't complain about the dirname + debuild $CHECKBUILDDEP -- clean + + # Clean up the package related files + if [ "$DEBCLEAN_CLEANDEBS" = yes ]; then + cd .. + rm -f *.changes *.deb *.build + fi + ) +done diff --git a/scripts/debcommit.pl b/scripts/debcommit.pl new file mode 100755 index 0000000..9e21d22 --- /dev/null +++ b/scripts/debcommit.pl @@ -0,0 +1,953 @@ +#!/usr/bin/perl + +=head1 NAME + +debcommit - commit changes to a package + +=head1 SYNOPSIS + +B [I] [B<--all> | I] + +=head1 DESCRIPTION + +B generates a commit message based on new text in B, +and commits the change to a package's repository. It must be run in a working +copy for the package. Supported version control systems are: +B, B, B (mercurial), B, B (Subversion), +B, B, B (arch), B. + +=head1 OPTIONS + +=over 4 + +=item B<-c>, B<--changelog> I + +Specify an alternate location for the changelog. By default debian/changelog is +used. + +=item B<-r>, B<--release> + +Commit a release of the package. The version number is determined from +debian/changelog, and is used to tag the package in the repository. + +Note that svn/svk tagging conventions vary, so debcommit uses +svnpath(1) to determine where the tag should be placed in the +repository. + +=item B<-R>, B<--release-use-changelog> + +When used in conjunction with B<--release>, if there are uncommitted +changes to the changelog then derive the commit message from those +changes rather than using the default message. + +=item B<-m> I, B<--message> I + +Specify a commit message to use. Useful if the program cannot determine +a commit message on its own based on debian/changelog, or if you want to +override the default message. + +=item B<-n>, B<--noact> + +Do not actually do anything, but do print the commands that would be run. + +=item B<-d>, B<--diff> + +Instead of committing, do print the diff of what would have been committed if +this option were not given. A typical usage scenario of this option is the +generation of patches against the current working copy (e.g. when you don't have +commit access right). + +=item B<-C>, B<--confirm> + +Display the generated commit message and ask for confirmation before committing +it. It is also possible to edit the message at this stage; in this case, the +confirmation prompt will be re-displayed after the editing has been performed. + +=item B<-e>, B<--edit> + +Edit the generated commit message in your favorite editor before committing +it. + +=item B<-a>, B<--all> + +Commit all files. This is the default operation when using a VCS other +than git. + +=item B<-s>, B<--strip-message>, B<--no-strip-message> + +If this option is set and the commit message has been derived from the +changelog, the characters "* " will be stripped from the beginning of +the message. + +This option is set by default and ignored if more than one line of +the message begins with "[*+-] ". + +=item B<--sign-commit>, B<--no-sign-commit> + +If this option is set, then the commits that debcommit creates will be +signed using gnupg. Currently this is only supported by git, hg, and bzr. + +=item B<--sign-tags>, B<--no-sign-tags> + +If this option is set, then tags that debcommit creates will be signed +using gnupg. Currently this is only supported by git. + +=item B<--changelog-info> + +If this option is set, the commit author and date will be determined from +the Maintainer and Date field of the first paragraph in F. +This is mainly useful when using B(1) with the B<--no-mainttrailer> +option. + +=back + +=head1 CONFIGURATION VARIABLES + +The two configuration files F and +F<~/.devscripts> are sourced by a shell in that order to set +configuration variables. Command line options can be used to override +configuration file settings. Environment variable settings are +ignored for this purpose. The currently recognised variables are: + +=over 4 + +=item B + +If this is set to I, then it is the same as the B<--no-strip-message> +command line parameter being used. The default is I. + +=item B + +If this is set to I, then it is the same as the B<--sign-tags> command +line parameter being used. The default is I. + +=item B + +If this is set to I, then it is the same as the B<--sign-commit> +command line parameter being used. The default is I. + +=item B + +If this is set to I, then it is the same as the B<--release-use-changelog> +command line parameter being used. The default is I. + +=item B + +This is the key id used for signing tags. If not set, a default will be +chosen by the revision control system. + +=back + +=head1 VCS SPECIFIC FEATURES + +=over 4 + +=item B / B + +If the commit message contains more than 72 characters, a summary will +be created containing as many full words from the message as will fit within +72 characters, followed by an ellipsis. + +=back + +Each of the features described below is applicable only if the commit message +has been automatically determined from the changelog. + +=over 4 + +=item B + +If only a single change is detected in the changelog, B will unfold +it to a single line and behave as if B<--strip-message> was used. + +Otherwise, the first change will be unfolded and stripped to form a summary line +and a commit message formed using the summary line followed by a blank line and +the changes as extracted from the changelog. B will then spawn an +editor so that the message may be fine-tuned before committing. + +=item B / B + +The first change detected in the changelog will be unfolded to form a single line +summary. If multiple changes were detected then an editor will be spawned to +allow the message to be fine-tuned. + +=item B + +If the changelog entry used for the commit message closes any bugs then B<--fixes> +options to "bzr commit" will be generated to associate the revision and the bugs. + +=back + +=cut + +use warnings; +use strict; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use Cwd; +use File::Basename; +use File::HomeDir; +use File::Temp; +my $progname = basename($0); + +my $modified_conf_msg; + +sub usage { + print <<"EOT"; +Usage: $progname [options] [files to commit] + $progname --version + $progname --help + +Generates a commit message based on new text in debian/changelog, +and commit the change to a package\'s repository. + +Options: + -c --changelog=path Specify the location of the changelog + -r --release Commit a release of the package and create a tag + -R --release-use-changelog + Take any uncommitted changes in the changelog in + to account when determining the commit message + for a release + -m --message=text Specify a commit message + -n --noact Dry run, no actual commits + -d --diff Print diff on standard output instead of committing + -C --confirm Ask for confirmation of the message before commit + -e --edit Edit the message in EDITOR before commit + -a --all Commit all files (default except for git) + -s --strip-message Strip the leading '* ' from the commit message (default) + --no-strip-message Do not strip a leading '* ' + --sign-commit Enable signing of the commit (git, hg, and bzr) + --no-sign-commit Do not sign the commit (default) + --sign-tags Enable signing of tags (git only) + --no-sign-tags Do not sign tags (default) + --changelog-info Use author and date information from the changelog + for the commit (git, hg, and bzr) + -h --help This message + -v --version Version information + + --no-conf, --noconf + Don\'t read devscripts config files; + must be the first option given + +Default settings modified by devscripts configuration files: +$modified_conf_msg + +EOT +} + +sub version { + print <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright by Joey Hess , all rights reserved. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. +EOF +} + +my $release = 0; +my $message; +my $release_use_changelog = 0; +my $noact = 0; +my $diffmode = 0; +my $confirm = 0; +my $edit = 0; +my $all = 0; +my $stripmessage = 1; +my $signcommit = 0; +my $signtags = 0; +my $changelog; +my $changelog_info = 0; +my $keyid; +my ($package, $version, $date, $maintainer); +my $onlydebian = 0; + +# Now start by reading configuration files and then command line +# The next stuff is boilerplate + +if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { + $modified_conf_msg = " (no configuration files read)"; + shift; +} else { + my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); + my %config_vars = ( + 'DEBCOMMIT_STRIP_MESSAGE' => 'yes', + 'DEBCOMMIT_SIGN_COMMITS' => 'no', + 'DEBCOMMIT_SIGN_TAGS' => 'no', + 'DEBCOMMIT_RELEASE_USE_CHANGELOG' => 'no', + 'DEBSIGN_KEYID' => '', + ); + my %config_default = %config_vars; + + my $shell_cmd; + # Set defaults + foreach my $var (keys %config_vars) { + $shell_cmd .= qq[$var="$config_vars{$var}";\n]; + } + $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; + $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; + # Read back values + foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } + my $shell_out = `/bin/bash -c '$shell_cmd'`; + @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; + + # Check validity + $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} =~ /^(yes|no)$/ + or $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} = 'yes'; + $config_vars{'DEBCOMMIT_SIGN_COMMITS'} =~ /^(yes|no)$/ + or $config_vars{'DEBCOMMIT_SIGN_COMMITS'} = 'no'; + $config_vars{'DEBCOMMIT_SIGN_TAGS'} =~ /^(yes|no)$/ + or $config_vars{'DEBCOMMIT_SIGN_TAGS'} = 'no'; + $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} =~ /^(yes|no)$/ + or $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} = 'no'; + + foreach my $var (sort keys %config_vars) { + if ($config_vars{$var} ne $config_default{$var}) { + $modified_conf_msg .= " $var=$config_vars{$var}\n"; + } + } + $modified_conf_msg ||= " (none)\n"; + chomp $modified_conf_msg; + + $stripmessage = $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} eq 'no' ? 0 : 1; + $signcommit = $config_vars{'DEBCOMMIT_SIGN_COMMITS'} eq 'no' ? 0 : 1; + $signtags = $config_vars{'DEBCOMMIT_SIGN_TAGS'} eq 'no' ? 0 : 1; + $release_use_changelog + = $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} eq 'no' ? 0 : 1; + if (exists $config_vars{'DEBSIGN_KEYID'} + && length $config_vars{'DEBSIGN_KEYID'}) { + $keyid = $config_vars{'DEBSIGN_KEYID'}; + } +} + +# Find a good default for the changelog file location + +for (qw"debian/changelog changelog") { + if (-e $_) { + $changelog = $_; + last; + } +} + +# Now read the command line arguments + +if ( + !GetOptions( + "r|release" => \$release, + "m|message=s" => \$message, + "n|noact" => \$noact, + "d|diff" => \$diffmode, + "C|confirm" => \$confirm, + "e|edit" => \$edit, + "a|all" => \$all, + "c|changelog=s" => \$changelog, + "s|strip-message!" => \$stripmessage, + "sign-commit!" => \$signcommit, + "sign-tags!" => \$signtags, + "changelog-info!" => \$changelog_info, + "R|release-use-changelog!" => \$release_use_changelog, + "h|help" => sub { usage(); exit 0; }, + "v|version" => sub { version(); exit 0; }, + 'noconf|no-conf' => sub { die '--noconf must be first option'; }, + ) +) { + die "Usage: $progname [options] [--all | files to commit]\n"; +} + +if ($diffmode) { + $confirm = 0; + $edit = 0; +} + +my @files_to_commit = @ARGV; +if (@files_to_commit && !grep(/$changelog/, @files_to_commit)) { + push @files_to_commit, $changelog; +} + +# Main program + +my $prog = getprog(); +if (!defined $changelog) { + die "debcommit: Could not find a Debian changelog\n"; +} +if (!-e $changelog) { + die "debcommit: cannot find $changelog\n"; +} + +$message = getmessage() + if !defined $message and (not $release or $release_use_changelog); + +if ($release || $changelog_info) { + require Dpkg::Changelog::Parse; + my $log = Dpkg::Changelog::Parse::changelog_parse(file => $changelog); + if ($release) { + if ($log->{Distribution} =~ /UNRELEASED/) { + die +"debcommit: $changelog says it's UNRELEASED\nTry running dch --release first\n"; + } + $package = $log->{Source}; + $version = $log->{Version}; + + $message = "releasing package $package version $version" + if !defined $message; + } + if ($changelog_info) { + $maintainer = $log->{Maintainer}; + $date = $log->{Date}; + } +} + +if ($edit) { + my $modified = 0; + ($message, $modified) = edit($message); + die "$progname: Commit message not modified / saved; aborting\n" + unless $modified; +} + +if (not $confirm or confirm($message)) { + commit($message); + tag($package, $version) if $release; +} + +# End of code, only subs below + +sub getprog { + if (-d "debian") { + if (-d "debian/.svn") { + # SVN has .svn even in subdirs... + if (!-d ".svn") { + $onlydebian = 1; + } + return "svn"; + } elsif (-d "debian/CVS") { + # CVS has CVS even in subdirs... + if (!-d "CVS") { + $onlydebian = 1; + } + return "cvs"; + } elsif (-d "debian/{arch}") { + # I don't think we can tell just from the working copy + # whether to use tla or baz, so try baz if it's available, + # otherwise fall back to tla. + if (system("baz --version >/dev/null 2>&1") == 0) { + return "baz"; + } else { + return "tla"; + } + } elsif (-d "debian/_darcs") { + $onlydebian = 1; + return "darcs"; + } + } + if (-d ".svn") { + return "svn"; + } + if (-d "CVS") { + return "cvs"; + } + if (-d "{arch}") { + # I don't think we can tell just from the working copy + # whether to use tla or baz, so try baz if it's available, + # otherwise fall back to tla. + if (system("baz --version >/dev/null 2>&1") == 0) { + return "baz"; + } else { + return "tla"; + } + } + if (-d ".bzr") { + return "bzr"; + } + if (-e ".git") { +# With certain forms of git checkouts, .git can be a file instead of a directory + return "git"; + } + if (-d ".hg") { + return "hg"; + } + if (-d "_darcs") { + return "darcs"; + } + + # Test for this file to avoid interactive prompting from svk. + if (-d File::HomeDir->my_home . "/.svk/local") { + # svk has no useful directories so try to run it. + my $svkpath + = `svk info . 2>/dev/null| grep -i '^Depot Path:' | cut -d ' ' -f 3`; + if (length $svkpath) { + return "svk"; + } + } + + # .bzr, .git, .hg, or .svn may be in a parent directory, rather than the + # current directory, if multiple packages are kept in one repository. + my $dir = getcwd(); + while ($dir =~ s/[^\/]*\/?$// && length $dir) { + if (-d "$dir/.bzr") { + return "bzr"; + } + if (-e "$dir/.git") { + return "git"; + } + if (-d "$dir/.hg") { + return "hg"; + } + if (-d "$dir/.svn") { + return "svn"; + } + } + + die +"debcommit: not in a cvs, Subversion, baz, bzr, git, hg, svk or darcs working copy\n"; +} + +sub action { + my $prog = shift; + if ($prog eq "darcs" && $onlydebian) { + splice(@_, 1, 0, "--repodir=debian"); + } + print $prog, " ", join( + " ", + map { + if (/[^-A-Za-z0-9]/) { "'$_'" } + else { $_ } + } @_ + ), + "\n"; + return 1 if $noact; + return (system($prog, @_) != 0) ? 0 : 1; +} + +sub bzr_find_fixes { + my $message = shift; + + require Dpkg::Changelog::Entry::Debian; + require Dpkg::Vendor::Ubuntu; + + my @debian_closes = Dpkg::Changelog::Entry::Debian::find_closes($message); + my $launchpad_closes + = Dpkg::Vendor::Ubuntu::find_launchpad_closes($message); + + my @fixes_arg = (); + map { push(@fixes_arg, ("--fixes", "deb:" . $_)) } @debian_closes; + map { push(@fixes_arg, ("--fixes", "lp:" . $_)) } @$launchpad_closes; + return @fixes_arg; +} + +sub commit { + my $message = shift; + + die "debcommit: can't specify a list of files to commit when using --all\n" + if (@files_to_commit and $all); + + my $action_rc; # return code of external command + if ($prog =~ /^(cvs|svn|svk|hg)$/) { + if (!@files_to_commit && $onlydebian) { + @files_to_commit = ("debian"); + } + my @extra_args; + if ($changelog_info && $prog eq 'hg') { + push(@extra_args, '-u', $maintainer, '-d', $date); + } + $action_rc + = $diffmode + ? action($prog, "diff", @files_to_commit) + : action($prog, "commit", "-m", $message, @extra_args, + @files_to_commit); + if ($prog eq 'hg' && $action_rc && $signcommit) { + my @sign_args; + push(@sign_args, '-k', $keyid) if $keyid; + push(@sign_args, '-u', $maintainer, '-d', $date) + if $changelog_info; + if (!action($prog, 'sign', @sign_args)) { + die "$progname: failed to sign commit\n"; + } + } + } elsif ($prog eq 'git') { + if (!@files_to_commit && ($all || $release)) { + # check to see if the WC is clean. git-commit would exit + # nonzero, so don't run it in --all or --release mode. + my $status = `git status --porcelain`; + if (!$status) { + print $status; + return; + } + } + if ($diffmode) { + $action_rc = action($prog, "diff", @files_to_commit); + } else { + if ($all) { + @files_to_commit = ("-a"); + } + my @extra_args = (); + if ($changelog_info) { + @extra_args = ("--author=$maintainer", "--date=$date"); + } + if ($signcommit) { + my $sign = '--gpg-sign'; + $sign .= "=$keyid" if $keyid; + push(@extra_args, $sign); + } + $action_rc = action($prog, "commit", "-m", $message, @extra_args, + @files_to_commit); + } + } elsif ($prog eq 'tla' || $prog eq 'baz') { + my $summary = $message; + $summary =~ s/^((?:\* )?[^\n]{1,72})(?:(?:\s|\n).*|$)/$1/ms; + my @args; + if (!$diffmode) { + if ($summary eq $message) { + $summary =~ s/^\* //s; + @args = ("-s", $summary); + } else { + $summary =~ s/^\* //s; + @args = ("-s", "$summary ...", "-L", $message); + } + } + push(@args, (($prog eq 'tla') ? '--' : ()), @files_to_commit,) + if @files_to_commit; + $action_rc = action($prog, $diffmode ? "diff" : "commit", @args); + } elsif ($prog eq 'bzr') { + if ($diffmode) { + $action_rc = action($prog, "diff", @files_to_commit); + } else { + my @extra_args = bzr_find_fixes($message); + if ($changelog_info) { + eval { + require Date::Format; + require Date::Parse; + }; + if ($@) { + my $error + = "$progname: Couldn't format the changelog date: "; + if ($@ =~ m%^Can\'t locate Date%) { + $error + .= "the libtimedate-perl package is not installed"; + } else { + $error .= "couldn't load Date::Format/Date::Parse: $@"; + } + die "$error\n"; + } + my @time = Date::Parse::strptime($date); + my $time + = Date::Format::strftime('%Y-%m-%d %H:%M:%S %z', \@time); + push(@extra_args, + "--author=$maintainer", "--commit-time=$time"); + } + my @sign_args; + if ($signcommit) { + push(@sign_args, "-Ocreate_signatures=always"); + if ($keyid) { + push(@sign_args, "-Ogpg_signing_key=$keyid"); + } + } + $action_rc = action($prog, @sign_args, "commit", "-m", $message, + @extra_args, @files_to_commit); + } + } elsif ($prog eq 'darcs') { + if (!@files_to_commit && ($all || $release)) { + # check to see if the WC is clean. darcs record would exit + # nonzero, so don't run it in --all or --release mode. + $action_rc = action($prog, "status"); + if (!$action_rc) { + return; + } + } + if ($diffmode) { + $action_rc = action($prog, "diff", @files_to_commit); + } else { + my $fh = File::Temp->new(TEMPLATE => '.commit-tmp.XXXXXX'); + $fh->print("$message\n"); + $fh->close(); + $action_rc = action($prog, "record", "--logfile", "$fh", "-a", + @files_to_commit); + } + } else { + die "debcommit: unknown program $prog"; + } + die "debcommit: commit failed\n" if (!$action_rc); +} + +sub tag { + my ($package, $tag, $tag_msg) = @_; + + # Make the message here so we can mangle $tag later, if needed + $tag_msg + = !defined $message + ? "tagging package $package version $tag" + : "$message"; + + if ($prog eq 'svn' || $prog eq 'svk') { + my $svnpath = `svnpath`; + chomp $svnpath; + my $tagpath = `svnpath tags`; + chomp $tagpath; + + if (!action($prog, "copy", $svnpath, "$tagpath/$tag", "-m", $tag_msg)) + { + if ( + !action( + $prog, "mkdir", $tagpath, "-m", "create tag directory" + ) + || !action( + $prog, "copy", $svnpath, "$tagpath/$tag", + "-m", $tag_msg + ) + ) { + die "debcommit: failed tagging with $tag\n"; + } + } + } elsif ($prog eq 'cvs') { + $tag =~ s/^[0-9]+://; # strip epoch + $tag =~ tr/./_/; # mangle for cvs + $tag = "debian_version_$tag"; + if (!action("cvs", "tag", "-f", $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } elsif ($prog eq 'tla' || $prog eq 'baz') { + my $archpath = `archpath`; + chomp $archpath; + my $tagpath = `archpath releases--\Q$tag\E`; + chomp $tagpath; + my $subcommand; + if ($prog eq 'baz') { + $subcommand = "branch"; + } else { + $subcommand = "tag"; + } + + if (!action($prog, $subcommand, $archpath, $tagpath)) { + die "debcommit: failed tagging with $tag\n"; + } + } elsif ($prog eq 'bzr') { + if (action("$prog tags >/dev/null 2>&1")) { + if (!action($prog, "tag", $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } else { + die + "debcommit: bazaar or branch version too old to support tags\n"; + } + } elsif ($prog eq 'git') { + $tag =~ tr/~/_/; # mangle for git + $tag =~ tr/:/%/; + if ($tag =~ /-/) { + # not a native package, so tag as a debian release + $tag = "debian/$tag"; + } + + if ($signtags) { + my $tag_msg = "tagging package $package version $tag"; + if (defined $keyid) { + if ( + !action( + $prog, "tag", "-a", "-u", + $keyid, "-m", $tag_msg, $tag + ) + ) { + die "debcommit: failed tagging with $tag\n"; + } + } else { + if (!action($prog, "tag", "-a", "-s", "-m", $tag_msg, $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } + } elsif (!action($prog, "tag", "-a", "-m", $tag_msg, $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } elsif ($prog eq 'hg') { + $tag =~ s/^[0-9]+://; # strip epoch + $tag = "debian-$tag"; + if (!action($prog, "tag", "-m", $tag_msg, $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } elsif ($prog eq 'darcs') { + if (!action($prog, "tag", $tag)) { + die "debcommit: failed tagging with $tag\n"; + } + } else { + die "debcommit: unknown program $prog"; + } +} + +sub getmessage { + my $ret; + + if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg|darcs)$/) { + $ret = ''; + my @diffcmd; + + if ($prog eq 'tla') { + @diffcmd = ($prog, 'diff', '-D', '-w', '--'); + } elsif ($prog eq 'baz') { + @diffcmd = ($prog, 'file-diff'); + } elsif ($prog eq 'bzr') { + @diffcmd = ($prog, 'diff', '--diff-options', '-wu'); + } elsif ($prog eq 'git') { + if (git_repo_has_commits()) { + if ($all) { + @diffcmd = ('git', 'diff', '-w', '--no-color'); + } else { + @diffcmd = ('git', 'diff', '-w', '--cached', '--no-color'); + } + } else { + # No valid head! Rather than fail, cheat and use 'diff' + @diffcmd = ('diff', '-u', '/dev/null'); + } + } elsif ($prog eq 'svn') { + @diffcmd = ( + $prog, 'diff', '--diff-cmd', '/usr/bin/diff', '--extensions', + '-wu' + ); + } elsif ($prog eq 'svk') { + $ENV{'SVKDIFF'} = '/usr/bin/diff -w -u'; + @diffcmd = ($prog, 'diff'); + } elsif ($prog eq 'darcs') { + @diffcmd = ($prog, 'diff', '--diff-opts=-wu'); + if ($onlydebian) { + push(@diffcmd, '--repodir=debian'); + } + } else { + @diffcmd = ($prog, 'diff', '-w'); + } + + open CHLOG, '-|', @diffcmd, $changelog + or die "debcommit: cannot run $diffcmd[0]: $!\n"; + + foreach () { + next unless s/^\+( |\t)//; + next if /^\s*\[.*\]\s*$/; # maintainer name + $ret .= $_; + } + + if (!length $ret) { + if ($release) { + return; + } else { + my $info = ''; + if ($prog eq 'git') { + $info + = ' (do you mean "debcommit -a" or did you forget to run "git add"?)'; + } + die +"debcommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n"; + } + } else { + if ($prog =~ /^(git|hg|darcs)$/ and not $diffmode) { + my $count = () = $ret =~ /^\s*[\*\+-] /mg; + + if ($count == 1) { + # Unfold + $ret =~ s/\n\s+/ /mg; + } else { + my $summary = ''; + + # We're constructing a message that can be used as a + # good starting point, the user will need to fine-tune it + $edit = 1; + + $summary = $ret; + # Strip off the second and subsequent changes + $summary =~ s/(^\* .*?)^\s*[\*\+-] .*/$1/ms; + # Unfold + $summary =~ s/\n\s+/ /mg; + + if ($prog eq 'git') { + $summary =~ s/^\* //; + $ret = $summary . "\n" . $ret; + } else { + # Strip off the first change so that we can prepend + # the unfolded version + $ret =~ s/^\* .*?(^\s*[\*\+-] .*)/$1\n/msg; + $ret = $summary . $ret; + } + } + } + + if ($stripmessage or $prog eq 'git') { + my $count = () = $ret =~ /^[ \t]*[\*\+-] /mg; + if ($count == 1) { + $ret =~ s/^[ \t]*[\*\+-] //; + $ret =~ s/^[ \t]*//mg; + } + } + } + } else { + die "debcommit: unknown program $prog"; + } + + chomp $ret; + return $ret; +} + +sub confirm { + my $confirmmessage = shift; + print $confirmmessage, "\n--\n"; + while (1) { + print "OK to commit? [Y/n/e] "; + $_ = ; + return 0 if /^n/i; + if (/^(y|$)/i) { + $message = $confirmmessage; + return 1; + } elsif (/^e/i) { + ($confirmmessage) = edit($confirmmessage); + print "\n", $confirmmessage, "\n--\n"; + } + } +} + +# The string returned by edit is chomp()ed, so anywhere we present that string +# to the user again needs to have a \n tacked on to the end. +sub edit { + my $message = shift; + my $fh = File::Temp->new(TEMPLATE => '.commit-tmp.XXXXXX') + || die "$progname: unable to create a temporary file.\n"; + # Ensure the message we present to the user has an EOL on the last line. + chomp($message); + $fh->print("$message\n"); + $fh->close(); + my $mtime = (stat("$fh"))[9]; + defined $mtime + || die +"$progname: unable to retrieve modification time for temporary file: $!\n"; + $mtime--; + utime $mtime, $mtime, $fh->filename; + system("sensible-editor $fh"); + open(FH, '<', "$fh") + || die "$progname: unable to open temporary file for reading\n"; + $message = ""; + + while () { + $message .= $_; + } + close(FH); + my $newmtime = (stat("$fh"))[9]; + defined $newmtime + || die +"$progname: unable to retrieve modification time for updated temporary file: $!\n"; + chomp $message; + return ($message, $mtime != $newmtime); +} + +sub git_repo_has_commits { + my $command = "git rev-parse --verify --quiet HEAD >/dev/null"; + system $command; + return ($? >> 8 == 0) ? 1 : 0; +} + +=head1 LICENSE + +This code is copyright by Joey Hess , all rights reserved. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. + +=head1 AUTHOR + +Joey Hess + +=head1 SEE ALSO + +B(1), B(1) + +=cut diff --git a/scripts/debdiff-apply b/scripts/debdiff-apply new file mode 100755 index 0000000..5875417 --- /dev/null +++ b/scripts/debdiff-apply @@ -0,0 +1,332 @@ +#!/usr/bin/python3 +# Copyright (c) 2016-2017, Ximin Luo +# +# This program 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 3 +# of the License, or (at your option) any later version. +# +# This program 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. +# +# See file /usr/share/common-licenses/GPL-3 for more details. +# +""" +Apply a debdiff to a Debian source package. + +It handles d/changelog hunks specially, to avoid conflicts. + +Depends on dpkg-dev, devscripts, python3-unidiff, quilt. +""" + +import argparse +import email.utils +import hashlib +import logging +import os +import shutil +import subprocess +import sys +import tempfile +import time + +import unidiff + +from debian.changelog import Changelog, ChangeBlock + +# this can be any valid value, it doesn't appear in the final output +DCH_DUMMY_TAIL = "\n -- debdiff-apply dummy tool " \ + "Thu, 01 Jan 1970 00:00:00 +0000\n\n" +CHBLOCK_DUMMY_PACKAGE = "debdiff-apply PLACEHOLDER" +TRY_ENCODINGS = ["utf-8", "latin-1"] +DISTRIBUTION_DEFAULT = "experimental" + + +def workaround_dpkg_865430(dscfile, origdir, stdout): + filename = subprocess.check_output( + ["dcmd", "--tar", "echo", dscfile]).rstrip() + if not os.path.exists(os.path.join(origdir.encode("utf-8"), os.path.basename(filename))): + subprocess.check_call( + ["dcmd", "--tar", "cp", dscfile, origdir], stdout=stdout) + + +def is_dch(path): + dirname = os.path.dirname(path) + return (os.path.basename(path) == 'changelog' + and os.path.basename(dirname) == 'debian' + and os.path.dirname(os.path.dirname(dirname)) == '') + + +def hunk_lines_to_str(hunk_lines): + return "".join(map(lambda x: str(x)[1:], hunk_lines)) + + +def read_dch_patch(dch_patch): + if len(dch_patch) > 1: + raise ValueError("don't know how to deal with debian/changelog patch " + "that has more than one hunk") + hunk = dch_patch[0] + source_str = hunk_lines_to_str(hunk.source_lines()) + DCH_DUMMY_TAIL + target_str = hunk_lines_to_str(hunk.target_lines()) + # here we assume the debdiff has enough context to see the previous version + # this should be true all the time in practice + source_version = str(Changelog(source_str, 1)[0].version) + target = Changelog(target_str, 1)[0] + return source_version, target + + +def apply_dch_patch(source_file, current, old_version, target, dry_run): + target_version = str(target.version) + + if not old_version or not target_version.startswith(old_version): + logging.warning("don't know how to rebase version-change (%s => %s) onto %s", + old_version, target_version, old_version) + newlog = subprocess.getoutput("EDITOR=cat dch -n 2>/dev/null").rstrip() + version = str(Changelog(newlog, 1)[0].version) + logging.warning("using version %s based on `dch -n`; feel free to make me smarter", + version) + else: + version_suffix = target_version[len(old_version):] + version = str(current[0].version) + version_suffix + logging.info("using version %s based on suffix %s", + version, version_suffix) + + if dry_run: + return version + + current._blocks.insert(0, target) # pylint: disable=protected-access + current.set_version(version) + + shutil.copy(source_file, source_file + ".new") + try: + with open(source_file + ".new", "w") as fp: + current.write_to_open_file(fp) + os.rename(source_file + ".new", source_file) + except Exception: + logging.warning("failed to patch %s", source_file) + logging.warning("half-applied changes in %s", source_file + ".new") + logging.warning("current working directory is %s", os.getcwd()) + raise + return version + + +def call_patch(patch_str, *args, check=True, **kwargs): + return subprocess.run( + ["patch", "-p1"] + list(args), + input=patch_str, + universal_newlines=True, + check=check, + **kwargs) + + +def check_patch(patch_str, *args, **kwargs): + return call_patch(patch_str, + "--dry-run", "-f", "--silent", + *args, + check=False, + stdout=subprocess.DEVNULL, + stderr=subprocess.DEVNULL, + **kwargs).returncode == 0 + + +def debdiff_apply(patch, patch_name, args): + # don't change anything if... + dry_run = args.target_version or args.source_version + + changelog = list(filter(lambda x: is_dch(x.path), patch)) + if not changelog: + logging.info("no debian/changelog in patch: %s", args.patch_file) + old_version = None + target = ChangeBlock( + package=CHBLOCK_DUMMY_PACKAGE, + author="%s <%s>" % (os.getenv("DEBFULLNAME"), + os.getenv("DEBEMAIL")), + date=email.utils.formatdate(time.time(), localtime=True), + version=None, + distributions=args.distribution, + urgency="low", + changes=["", " * Rebase patch %s." % patch_name, ""], + ) + target.add_trailing_line("") + elif len(changelog) > 1: + raise ValueError("more than one debian/changelog patch???") + else: + patch.remove(changelog[0]) + old_version, target = read_dch_patch(changelog[0]) + + if args.source_version: + if old_version: + print(old_version) + return False + + # read this here so --source-version can work even without a d/changelog + with open(args.changelog) as fp: + current = Changelog(fp.read()) + if target.package == CHBLOCK_DUMMY_PACKAGE: + target.package = current[0].package + + if not dry_run: + patch_str = str(patch) + if check_patch(patch_str, "-N"): + call_patch(patch_str) + logging.info("patch %s applies!", patch_name) + elif check_patch(patch_str, "-R"): + logging.warning("patch %s already applied", patch_name) + return False + else: + call_patch(patch_str, "--dry-run", "-f") + raise ValueError("patch %s doesn't apply!" % (patch_name)) + + # only apply d/changelog patch if the rest of the patch applied + new_version = apply_dch_patch( + args.changelog, current, old_version, target, dry_run) + if args.target_version: + print(new_version) + return False + + if args.repl: + import code # pylint: disable=import-outside-toplevel + code.interact(local=locals()) + + return True + + +def parse_args(args): + parser = argparse.ArgumentParser( + description='Apply a debdiff to a Debian source package') + parser.add_argument( + '-v', '--verbose', action="store_true", + help='Output more information', + ) + parser.add_argument( + '-c', '--changelog', default='debian/changelog', + help='Path to debian/changelog; default: %(default)s', + ) + parser.add_argument( + '-D', '--distribution', default='experimental', + help='Distribution to use, if the patch doesn\'t already ' + 'contain a changelog; default: %(default)s', + ) + parser.add_argument( + '--repl', action="store_true", + help="Run the python REPL after processing.", + ) + parser.add_argument( + '--source-version', action="store_true", + help='Don\'t apply the patch; instead print out the version of the ' + 'package that it is supposed to be applied to, or nothing if ' + 'the patch does not specify a source version.', + ) + parser.add_argument( + '--target-version', action="store_true", + help="Don't apply the patch; instead print out the new version of the " + "package debdiff-apply(1) would generate, when the patch is applied to the " + "the given target package, as specified by the other arguments.", + ) + parser.add_argument( + 'orig_dsc_or_dir', nargs='?', default=".", + help="Target to apply the patch to. This can either be an unpacked " + "source tree, or a .dsc file. In the former case, the directory is " + "modified in-place; in the latter case, a second .dsc is created. " + "Default: %(default)s", + ) + parser.add_argument( + 'patch_file', nargs='?', default="/dev/stdin", + help="Patch file to apply, in the format output by debdiff(1). " + "Default: %(default)s", + ) + group1 = parser.add_argument_group('Options for .dsc patch targets') + group1.add_argument( + '--no-clean', action="store_true", + help="Don't clean temporary directories after a failure, so you can " + "examine what failed.", + ) + group1.add_argument( + '--quilt-refresh', action="store_true", + help="If the building of the new source package fails, try to refresh " + "patches using quilt(1) then try building it again.", + ) + group1.add_argument( + '-d', '--directory', default=None, + help="Extract the .dsc into this directory, which won't be cleaned up " + "after debdiff-apply(1) exits. If not given, then it will be extracted to a " + "temporary directory.", + ) + return parser.parse_args(args) + + +def main(args): + # Split this function! pylint: disable=too-many-branches,too-many-locals,too-many-statements + args = parse_args(args) + if args.verbose: + logging.getLogger().setLevel(logging.DEBUG) + + with open(args.patch_file, 'rb') as fp: + data = fp.read() + for enc in TRY_ENCODINGS: + try: + patch = unidiff.PatchSet( + data.splitlines(keepends=True), encoding=enc) + break + except Exception: # pylint: disable=broad-except + if enc == TRY_ENCODINGS[-1]: + raise + continue + + patch_name = '%s:%s' % ( + os.path.basename(args.patch_file), + hashlib.sha256(data).hexdigest()[:20 if args.patch_file == '/dev/stdin' else 8]) + quiet = args.source_version or args.target_version + dry_run = args.source_version or args.target_version + # user can redirect stderr themselves + stdout = subprocess.DEVNULL if quiet else None + + # change directory before applying patches + if os.path.isdir(args.orig_dsc_or_dir): + os.chdir(args.orig_dsc_or_dir) + debdiff_apply(patch, patch_name, args) + elif os.path.isfile(args.orig_dsc_or_dir): + dscfile = args.orig_dsc_or_dir + parts = os.path.splitext(os.path.basename(dscfile)) + if parts[1] != ".dsc": + raise ValueError("unrecognised patch target: %s" % dscfile) + extractdir = args.directory if args.directory else tempfile.mkdtemp() + if not os.path.isdir(extractdir): + os.makedirs(extractdir) + try: + # dpkg-source doesn't like existing dirs + builddir = os.path.join(extractdir, parts[0]) + subprocess.check_call(["dpkg-source", "-x", "--skip-patches", dscfile, builddir], + stdout=stdout) + origdir = os.getcwd() + workaround_dpkg_865430(dscfile, origdir, stdout) + os.chdir(builddir) + did_patch = debdiff_apply(patch, patch_name, args) + if dry_run or not did_patch: + return + os.chdir(origdir) + try: + subprocess.check_call(["dpkg-source", "-b", builddir]) + except subprocess.CalledProcessError: + if args.quilt_refresh: + subprocess.check_call(["sh", "-c", """ +set -ex +export QUILT_PATCHES=debian/patches +while quilt push; do quilt refresh; done +"""], cwd=builddir) + subprocess.check_call(["dpkg-source", "-b", builddir]) + else: + raise + finally: + cleandir = builddir if args.directory else extractdir + if args.no_clean: + logging.warning( + "you should clean up temp files in %s", cleandir) + else: + shutil.rmtree(cleandir) + + +if __name__ == "__main__": + sys.exit(main(sys.argv[1:])) diff --git a/scripts/debdiff-apply.1 b/scripts/debdiff-apply.1 new file mode 100644 index 0000000..cae8fbd --- /dev/null +++ b/scripts/debdiff-apply.1 @@ -0,0 +1,112 @@ +.\" Copyright (c) 2016-2017, Ximin Luo +.\" +.\" This program 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 3 +.\" of the License, or (at your option) any later version. +.\" +.\" This program 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. +.\" +.\" See file /usr/share/common-licenses/GPL-3 for more details. +.\" +.TH "DEBDIFF\-APPLY" 1 "Debian Utilities" "DEBIAN" + +.SH NAME +debdiff-apply \- apply a debdiff to a Debian source package + +.SH SYNOPSIS +.B debdiff-apply +[options] [orig_dsc_or_dir] [patch_file] +.br +.B debdiff-apply +[options] < [patch_file] + +.SH DESCRIPTION +.B debdiff-apply +takes a \fIpatchfile\fR that describes the differences between two Debian +source packages \fIold\fR and \fInew\fR, and applies it to a target Debian +source package \fIorig\fR. +.PP +\fIorig\fR could either be the same as \fIold\fR or it could be different. +\fIpatchfile\fR is expected to be a unified diff between two Debian source +trees, as what +.BR debdiff (1) +normally generates. +.PP +Any changes to \fIdebian/changelog\fR are dealt with specially, to avoid the +conflicts that changelog diffs typically produce when applied naively. The +exact behaviour may be tweaked in the future, so one should not rely on it. +.PP +If \fIpatchfile\fR does not apply to \fIorig\fR, even after the special-casing +of \fIdebian/changelog\fR, no changes are made and +.BR debdiff-apply (1) +will exit with a non-zero error code. + +.SH ARGUMENTS +.TP +orig_dsc_or_dir +Target to apply the patch to. This can either be an unpacked source tree, or a +\[char46]dsc file. In the former case, the directory is modified in\-place; in +the latter case, a second .dsc is created. Default: \fI.\fP +.TP +patch_file +Patch file to apply, in the format output by +.BR debdiff (1). +Default: +\fI\,/dev/stdin\/\fP + +.SH OPTIONS +.TP +\fB\-h\fR, \fB\-\-help\fR +show this help message and exit +.TP +\fB\-v\fR, \fB\-\-verbose\fR +Output more information +.TP +\fB\-c\fR CHANGELOG, \fB\-\-changelog\fR CHANGELOG +Path to debian/changelog; default: debian/changelog +.TP +\fB\-D\fR DISTRIBUTION, \fB\-\-distribution\fR DISTRIBUTION +Distribution to use, if the patch doesn't already contain a changelog; default: +experimental +.TP +\fB\-\-repl\fR +Run the python REPL after processing. +.TP +\fB\-\-source\-version\fR +Don't apply the patch; instead print out the version of the package that it is +supposed to be applied to, or nothing if the patch does not specify a source +version. +.TP +\fB\-\-target\-version\fR +Don't apply the patch; instead print out the new version of the package +.BR debdiff-apply (1) +would generate, when the patch is applied to the the given target +package, as specified by the other arguments. +.SS "For .dsc patch targets:" +.TP +\fB\-\-no\-clean\fR +Don't clean temporary directories after a failure, so you can examine what +failed. +.TP +\fB\-\-quilt\-refresh\fR +If the building of the new source package fails, try to refresh patches using +.BR quilt (1) +then try building it again. +.TP +\fB\-d\fR DIRECTORY, \fB\-\-directory\fR DIRECTORY +Extract the .dsc into this directory, which won't be cleaned up after +.BR debdiff-apply (1) +exits. If not given, then it will be extracted to a temporary directory. + +.SH AUTHORS +\fBdebdiff-apply\fR and this manual page were written by Ximin Luo + +.PP +Both are released under the GNU General Public License, version 3 or later. + +.SH SEE ALSO +.BR debdiff (1) diff --git a/scripts/debdiff.1 b/scripts/debdiff.1 new file mode 100644 index 0000000..878b7e8 --- /dev/null +++ b/scripts/debdiff.1 @@ -0,0 +1,251 @@ +.TH DEBDIFF 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debdiff \- compare file lists in two Debian packages +.SH SYNOPSIS +\fBdebdiff\fR [\fIoptions\fR] \fR +.br +\fBdebdiff\fR [\fIoptions\fR] ... \fIdeb1 deb2\fR +.br +\fBdebdiff\fR [\fIoptions\fR] ... \fIchanges1 changes2\fR +.br +\fBdebdiff\fR [\fIoptions\fR] ... \fB\-\-from \fIdeb1a deb1b ... +\fB\-\-to \fIdeb2a deb2b ...\fR +.br +\fBdebdiff\fR [\fIoptions\fR] ... \fIdsc1 dsc2\fR +.SH DESCRIPTION +\fBdebdiff\fR takes the names of two Debian package files (\fI.deb\fRs +or \fI.udeb\fRs) on the command line and compares their contents +(considering only the files in the main package, not the maintenance +scripts). It shows which files have been introduced and which removed +between the two package files, and is therefore useful for spotting +files which may have been inadvertently lost between revisions of the +package. It also checks the file owners and permissions, and compares +the control files of the two packages using the \fBwdiff\fR program. +If you want a deeper comparison of two Debian package files you can +use the \fBdiffoscope\fR tool. +.PP +If no arguments are given, \fBdebdiff\fR tries to compare the content +of the current source directory with the last version of the package. +.PP +\fBdebdiff\fR can also handle changes between groups of \fI.deb\fR +files in two ways. The first is to specify two \fI.changes\fR files. +In this case, the \fI.deb\fR files listed in the \fI.changes\fR file +will be compared, by taking the contents of all of the +listed \fI.deb\fR files together. (The \fI.deb\fR files listed are +assumed to be in the same directory as the \fI.changes\fR file.) The +second way is to list the \fI.deb\fR files of interest specifically +using the \fB\-\-from\fR ... \fB\-\-to\fR syntax. These both help if +a package is broken up into smaller packages and one wishes to ensure +that nothing is lost in the interim. +.PP +\fBdebdiff\fR examines the \fBdevscripts\fR configuration files as +described below. Command line options override the configuration file +settings, though. +.PP +If \fBdebdiff\fR is passed two source packages (\fI.dsc\fR files) it +will compare the contents of the source packages. If the source +packages differ only in Debian revision number (that is, +the \fI.orig.tar.gz\fR files are the same in the two \fI.dsc\fR +files), then \fBinterdiff\fR(1) will be used to compare the two patch +files if this program is available on the system, otherwise a +\fBdiff\fR will be performed between the two source trees. +.SH OPTIONS +.TP +.BR \-\-dirs ", " \-d +The default mode of operation is to ignore directory names which +appear in the file list, but they, too, will be considered if this +option is given. +.TP +.B \-\-nodirs +Ignore directory names which appear in the file list. This is the +default and it can be used to override a configuration file setting. +.TP +.BI \-\-move " FROM TO" "\fR,\fP \-m" " FROM TO" +It sometimes occurs that various files or directories are moved around +between revisions. This can be handled using this option. There are +two arguments, the first giving the location of the directory or file +in the first package, and the second in the second. Any files in the +first listing whose names begin with the first argument are treated as +having that substituted for the second argument when the file lists +are compared. Any number of \fB\-\-move\fR arguments may be given; +they are processed in the order in which they appear. This only affects +comparing binary packages, not source packages. +.TP +.BI \-\-move\-regex " FROM TO" +This is the same as \fB\-\-move\fR, except that \fIFROM\fR is treated +as a regular expression and the \fBperl\fR substitution command +\fIs/^FROM/TO/\fR is applied to the files. In particular, TO can make +use of backreferences such as $1. +.TP +.B \-\-nocontrol +\fBdebdiff\fR will usually compare the respective control files of the +packages using \fBwdiff\fR(1). This option suppresses this part of +the processing. +.TP +.B \-\-control +Compare the respective control files; this is the default, and it can +be used to override a configuration file setting. +.TP +.BI \-\-controlfiles " FILE\fR[\fP", "FILE\fR ...]\fP" +Specify which control files to compare; by default this is just +\fIcontrol\fR, but could include \fIpostinst\fR, \fIconfig\fR and so +on. Files will only be compared if they are present in both +\fI.debs\fR being compared. The special value \fIALL\fR compares all +control files present in both packages, except for md5sums. This +option can be used to override a configuration file setting. +.TP +.B \-\-wdiff\-source\-control +When processing source packages, compare control files using \fBwdiff\fR. +Equivalent to the \fB\-\-control\fR option for binary packages. +.TP +.B \-\-no\-wdiff\-source\-control +Do not compare control files in source packages using \fBwdiff\fR. This +is the default. +.TP +.BR \-\-wp ", " \-\-wl ", " \-\-wt +Pass a \fB\-p\fR, \fB\-l\fR or \fB\-t\fR option to \fBwdiff\fR +respectively. (This yields the whole \fBwdiff\fR output rather than +just the lines with any changes.) +.TP +.B \-\-show-moved +If multiple \fI.deb\fR files are specified on the command line, either +using \fI.changes\fR files or the \fB\-\-from\fR/\fB\-\-to\fR syntax, +then this option will also show which files (if any) have moved +between packages. (The package names are simply determined from the +names of the \fI.deb\fR files.) +.TP +.B \-\-noshow-moved +The default behaviour; can be used to override a configuration file +setting. +.TP +.BI \-\-renamed " FROM TO" +If \fB\-\-show-moved\fR is being used and a package has been renamed +in the process, this command instructs \fBdebdiff\fR to treat the +package in the first list called \fIFROM\fR as if it were called +\fITO\fR. Multiple uses of this option are permitted. +.TP +.BI \-\-exclude " PATTERN" +Exclude files whose basenames match \fIPATTERN\fR. +Multiple uses of this option are permitted. +Note that this option is passed on to \fBdiff\fR and has the same +behaviour, so only the basename of the file is considered: +in particular, \fB--exclude='*.patch'\fR will work, but +\fB--exclude='debian/patches/*'\fR will have no practical effect. +.TP +.B \-\-diffstat +Include the result of \fBdiffstat\fR before the generated diff. +.TP +.B \-\-no\-diffstat +The default behaviour; can be used to override a configuration file +setting. +.TP +.B \-\-auto\-ver\-sort +When comparing source packages, do so in version order. +.TP +.B \-\-no\-auto\-ver\-sort +Compare source packages in the order they were passed on the +command-line, even if that means comparing a package with a higher +version against one with a lower version. This is the default +behaviour. +.TP +.B \-\-unpack\-tarballs +When comparing source packages, also unpack tarballs found in the top level +source directory to compare their contents along with the other files. +This is the default behaviour. +.TP +.B \-\-no\-unpack\-tarballs +Do not unpack tarballs inside source packages. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +\fB\-\-debs\-dir\fR \fIdirectory\fR +Look for the \fI.dsc\fR files in \fIdirectory\fR +instead of the parent of the source directory. This should +either be an absolute path or relative to the top of the source +directory. +.TP +.BR \-\-help ", " \-h +Show a summary of options. +.TP +.BR \-\-version ", " \-v +Show version and copyright information. +.TP +.BR \-\-quiet ", " \-q +Be quiet if no differences were found. +.TP +.BR \-\-ignore\-space ", " \-w +Ignore whitespace in diffs. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced by a shell in that order to set +configuration variables. Command line options can be used to override +configuration file settings. Environment variable settings are +ignored for this purpose. The currently recognised variables are: +.TP +.B DEBDIFF_DIRS +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-dirs\fR command line parameter being used. +.TP +.B DEBDIFF_CONTROL +If this is set to \fIno\fR, then it is the same as the +\fB\-\-nocontrol\fR command line parameter being used. The default is +\fIyes\fR. +.TP +.B DEBDIFF_CONTROLFILES +Which control files to compare, corresponding to the +\fB\-\-controlfiles\fR command line option. The default is +\fIcontrol\fR. +.TP +.B DEBDIFF_SHOW_MOVED +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-show\-moved\fR command line parameter being used. +.TP +.B DEBDIFF_WDIFF_OPT +This option will be passed to \fBwdiff\fR; it should be one of +\fB\-p\fR, \fB\-l\fR or \fB\-t\fR. +.TP +.B DEBDIFF_SHOW_DIFFSTAT +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-diffstat\fR command line parameter being used. +.TP +.B DEBDIFF_WDIFF_SOURCE_CONTROL +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-wdiff\-source\-control\fR command line parameter being used. +.TP +.B DEBDIFF_AUTO_VER_SORT +If this is set to \fIyes\fR, then it is the same as the +\fB\-\-auto\-ver\-sort\fR command line parameter being used. +.TP +.B DEBDIFF_UNPACK_TARBALLS +If this is set to \fIno\fR, then it is the same as the +\fB\-\-no\-unpack\-tarballs\fR command line parameter being used. +.TP +.B DEBRELEASE_DEBS_DIR +This specifies the directory in which to look for the \fI.dsc\fR +and files, and is either an absolute path or relative to +the top of the source tree. This corresponds to the +\fB\-\-debs\-dir\fR command line option. This directive could be +used, for example, if you always use \fBpbuilder\fR or +\fBsvn-buildpackage\fR to build your packages. Note that it also +affects \fBdebrelease\fR(1) in the same way, hence the strange name of +the option. +.SH "EXIT VALUES" +Normally the exit value will be 0 if no differences are reported and 1 +if any are reported. If there is some fatal error, the exit code will +be 255. +.SH "SEE ALSO" +.BR debdiff-apply (1), +.BR diffstat (1), +.BR dpkg-deb (1), +.BR interdiff (1), +.BR wdiff (1), +.BR devscripts.conf (5), +.BR diffoscope (1) +.SH AUTHOR +\fBdebdiff\fR was originally written as a shell script by Yann Dirson + and rewritten in Perl with many more features by +Julian Gilbey . The software may be freely +redistributed under the terms and conditions of the GNU General Public +License, version 2. diff --git a/scripts/debdiff.bash_completion b/scripts/debdiff.bash_completion new file mode 100644 index 0000000..4a34c11 --- /dev/null +++ b/scripts/debdiff.bash_completion @@ -0,0 +1,153 @@ +# /usr/share/bash-completion/completions/debdiff +# Bash command completion for ‘debdiff(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +# This is free software, and you are welcome to redistribute it under +# certain conditions; see the end of this file for copyright +# information, grant of license, and disclaimer of warranty. + +_have debdiff && +_debdiff () { + local cur prev words cword + _init_completion || return + + local i + local command_name=debdiff + local options=( + -h --help -v --version + -q --quiet + -d --dirs --nodirs + -w --ignore-space + --diffstat --no-diffstat + --auto-ver-sort --no-auto-ver-sort + --unpack-tarballs --no-unpack-tarballs + --control --nocontrol --controlfiles + --wdiff-source-control --no-wdiff-source-control --wp --wl --wt + --show-moved --noshow-moved --renamed + --debs-dir + --from + --move --move-regex + --exclude + ) + + local file_list_mode=normal + local -i move_from=-1 + local -i move_to=-1 + + unset COMPREPLY + + case "$prev" in + "$command_name") + options+=( --noconf --no-conf ) + ;; + + --debs-dir) + COMPREPLY=( $( compgen -A directory -- "$cur" ) ) + ;; + + esac + + if [[ -v COMPREPLY ]] ; then + return 0 + fi + + for (( i=1; i<${#words[@]}; i++ )); do + if [[ $file_list_mode == @(deb|dsc|changes) ]]; then + if (( i == ${#words[@]}-1 )); then + break + else + COMPREPLY=() + return 0 + fi + fi + if (( ${move_from} == -1 && ${move_to} == -1 )); then + file_list_mode=normal + elif (( ${move_from} >= 0 && ${move_to} == -1 )); then + file_list_mode=from + elif (( ${move_from} >= 0 && ${move_to} >= 0 && ${move_to} < ${move_from} )); then + file_list_mode=to + else + COMPREPLY=() + return 0 + fi + if [[ $file_list_mode == normal && ${words[i]} == --from ]]; then + move_from=0 + file_list_mode=from + elif [[ $file_list_mode == normal && ${words[i]} == *.deb ]]; then + file_list_mode=deb + elif [[ $file_list_mode == normal && ${words[i]} == *.udeb ]]; then + file_list_mode=deb + elif [[ $file_list_mode == normal && ${words[i]} == *.dsc ]]; then + file_list_mode=dsc + elif [[ $file_list_mode == normal && ${words[i]} == *.changes ]]; then + file_list_mode=changes + elif [[ $file_list_mode == from && ${words[i]} == *.deb ]]; then + (( ++move_from )) + elif [[ $file_list_mode == from && ${words[i]} == *.udeb ]]; then + (( ++move_from )) + elif [[ $file_list_mode == from && ${words[i]} == --to ]]; then + move_to=0 + file_list_mode=to + elif [[ $file_list_mode = to && ${words[i]} == *.deb ]]; then + (( ++move_to )) + elif [[ $file_list_mode = to && ${words[i]} == *.udeb ]]; then + (( ++move_to )) + fi + done + + case $file_list_mode in + normal) + if [[ $prev == --debs-dir ]]; then + COMPREPLY=( $( compgen -G "${cur}*" ) ) + compopt -o dirnames + elif [[ $cur == -* ]]; then + COMPREPLY=( $( compgen -W "${options[*]}" -- "$cur" ) ) + else + COMPREPLY=( $( compgen -G "${cur}*.@(deb|udeb|dsc|changes)" ) ) + compopt -o filenames + compopt -o plusdirs + fi + ;; + deb|from|to) + COMPREPLY=( $( compgen -G "${cur}*.deb" "${cur}*.udeb" ) ) + if (( $move_from > 0 && $move_to < 0 )) ; then + COMPREPLY+=( $( compgen -W "--to" -- "$cur" ) ) + fi + compopt -o filenames + compopt -o plusdirs + ;; + dsc) + COMPREPLY=( $( compgen -G "${cur}*.dsc" ) ) + compopt -o filenames + compopt -o plusdirs + ;; + changes) + COMPREPLY=( $( compgen -G "${cur}*.changes" ) ) + compopt -o filenames + compopt -o plusdirs + ;; + *) + COMPREPLY=( $( compgen -W "${options[*]}" -- "$cur" ) ) + ;; + esac + + return 0 + +} && +complete -F _debdiff debdiff + + +# Copyright © 2016–2017 Ben Finney +# Copyright © 2015 Nicholas Bamber +# +# This is free software: you may copy, modify, and/or distribute this work +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; version 2 of that license or any later version. +# No warranty expressed or implied. See the file ‘LICENSE.GPL-2’ for details. + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/debdiff.pl b/scripts/debdiff.pl new file mode 100755 index 0000000..32426a2 --- /dev/null +++ b/scripts/debdiff.pl @@ -0,0 +1,1215 @@ +#!/usr/bin/perl + +# Original shell script version: +# Copyright 1998,1999 Yann Dirson +# Perl version: +# Copyright 1999,2000,2001 by Julian Gilbey +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License, version 2 ONLY, +# as published by the Free Software Foundation. +# +# This program 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. + +use 5.006_000; +use strict; +use warnings; +use Cwd; +use Dpkg::IPC; +use File::Copy qw(cp move); +use File::Basename; +use File::Spec; +use File::Path qw/ rmtree /; +use File::Temp qw/ tempdir tempfile /; +use Devscripts::Compression; +use Devscripts::Versort; + +# Predeclare functions +sub wdiff_control_files($$$$$); +sub process_debc($$); +sub process_debI($); +sub mktmpdirs(); +sub fatal(@); + +my $progname = basename($0); +my $modified_conf_msg; +my $exit_status = 0; +my $dummyname = "---DUMMY---"; + +my $compression_re = compression_get_file_extension_regex(); + +sub usage { + print <<"EOF"; +Usage: $progname [option] + or: $progname [option] ... deb1 deb2 + or: $progname [option] ... changes1 changes2 + or: $progname [option] ... dsc1 dsc2 + or: $progname [option] ... --from deb1a deb1b ... --to deb2a deb2b ... +Valid options are: + --no-conf, --noconf + Don\'t read devscripts config files; + must be the first option given + --help, -h Display this message + --version, -v Display version and copyright info + --move FROM TO, The prefix FROM in first packages has + -m FROM TO been renamed TO in the new packages + only affects comparing binary packages + (multiple permitted) + --move-regex FROM TO, The prefix FROM in first packages has + been renamed TO in the new packages + only affects comparing binary packages + (multiple permitted), using regexp substitution + --dirs, -d Note changes in directories as well as files + --nodirs Do not note changes in directories (default) + --nocontrol Skip comparing control files + --control Do compare control files + --controlfiles FILE,FILE,... + Which control files to compare; default is just + control; could include preinst, etc, config or + ALL to compare all control files present + --wp, --wl, --wt Pass the option -p, -l, -t respectively to wdiff + (only one should be used) + --wdiff-source-control When processing source packages, compare control + files as with --control for binary packages + --no-wdiff-source-control + Do not do so (default) + --show-moved Indicate also all files which have moved + between packages + --noshow-moved Do not also indicate all files which have moved + between packages (default) + --renamed FROM TO The package formerly called FROM has been + renamed TO; only of interest with --show-moved + (multiple permitted) + --quiet, -q Be quiet if no differences were found + --exclude PATTERN Exclude files whose basenames match PATTERN + --ignore-space, -w Ignore whitespace in diffs + --diffstat Include the result of diffstat before the diff + --no-diffstat Do not do so (default) + --auto-ver-sort When comparing source packages, ensure the + comparison is performed in version order + --no-auto-ver-sort Do not do so (default) + --unpack-tarballs Unpack tarballs found in the top level source + directory (default) + --no-unpack-tarballs Do not do so + +Default settings modified by devscripts configuration files: +$modified_conf_msg + +Use the diffoscope package for deeper comparisons of .deb files. +EOF +} + +my $version = <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999,2000,2001 by Julian Gilbey , +based on original code which is copyright 1998,1999 by +Yann Dirson +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 ONLY. +EOF + +# Start by setting default values + +my $debsdir; +my $debsdir_warning; +my $ignore_dirs = 1; +my $compare_control = 1; +my $controlfiles = 'control'; +my $show_moved = 0; +my $wdiff_opt = ''; +my @diff_opts = (); +my $show_diffstat = 0; +my $wdiff_source_control = 0; +my $auto_ver_sort = 0; +my $unpack_tarballs = 1; + +my $quiet = 0; + +# Next, read read configuration files and then command line +# The next stuff is boilerplate + +if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { + $modified_conf_msg = " (no configuration files read)"; + shift; +} else { + my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); + my %config_vars = ( + 'DEBDIFF_DIRS' => 'no', + 'DEBDIFF_CONTROL' => 'yes', + 'DEBDIFF_CONTROLFILES' => 'control', + 'DEBDIFF_SHOW_MOVED' => 'no', + 'DEBDIFF_WDIFF_OPT' => '', + 'DEBDIFF_SHOW_DIFFSTAT' => 'no', + 'DEBDIFF_WDIFF_SOURCE_CONTROL' => 'no', + 'DEBDIFF_AUTO_VER_SORT' => 'no', + 'DEBDIFF_UNPACK_TARBALLS' => 'yes', + 'DEBRELEASE_DEBS_DIR' => '..', + ); + my %config_default = %config_vars; + + my $shell_cmd; + # Set defaults + foreach my $var (keys %config_vars) { + $shell_cmd .= "$var='$config_vars{$var}';\n"; + } + $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; + $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; + # Read back values + foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } + my $shell_out = `/bin/bash -c '$shell_cmd'`; + @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; + + # Check validity + $config_vars{'DEBDIFF_DIRS'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_DIRS'} = 'no'; + $config_vars{'DEBDIFF_CONTROL'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_CONTROL'} = 'yes'; + $config_vars{'DEBDIFF_SHOW_MOVED'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_SHOW_MOVED'} = 'no'; + $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} = 'no'; + $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} = 'no'; + $config_vars{'DEBDIFF_AUTO_VER_SORT'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_AUTO_VER_SORT'} = 'no'; + $config_vars{'DEBDIFF_UNPACK_TARBALLS'} =~ /^(yes|no)$/ + or $config_vars{'DEBDIFF_UNPACK_TARBALLS'} = 'yes'; + # We do not replace this with a default directory to avoid accidentally + # installing a broken package + $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%/+%/%; + $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%(.)/$%$1%; + $debsdir_warning + = "config file specified DEBRELEASE_DEBS_DIR directory $config_vars{'DEBRELEASE_DEBS_DIR'} does not exist!"; + + foreach my $var (sort keys %config_vars) { + if ($config_vars{$var} ne $config_default{$var}) { + $modified_conf_msg .= " $var=$config_vars{$var}\n"; + } + } + $modified_conf_msg ||= " (none)\n"; + chomp $modified_conf_msg; + + $debsdir = $config_vars{'DEBRELEASE_DEBS_DIR'}; + $ignore_dirs = $config_vars{'DEBDIFF_DIRS'} eq 'yes' ? 0 : 1; + $compare_control = $config_vars{'DEBDIFF_CONTROL'} eq 'no' ? 0 : 1; + $controlfiles = $config_vars{'DEBDIFF_CONTROLFILES'}; + $show_moved = $config_vars{'DEBDIFF_SHOW_MOVED'} eq 'yes' ? 1 : 0; + $wdiff_opt = $config_vars{'DEBDIFF_WDIFF_OPT'} =~ /^-([plt])$/ ? $1 : ''; + $show_diffstat = $config_vars{'DEBDIFF_SHOW_DIFFSTAT'} eq 'yes' ? 1 : 0; + $wdiff_source_control + = $config_vars{'DEBDIFF_WDIFF_SOURCE_CONTROL'} eq 'yes' ? 1 : 0; + $auto_ver_sort = $config_vars{'DEBDIFF_AUTO_VER_SORT'} eq 'yes' ? 1 : 0; + $unpack_tarballs + = $config_vars{'DEBDIFF_UNPACK_TARBALLS'} eq 'yes' ? 1 : 0; + +} + +# Are they a pair of debs, changes or dsc files, or a list of debs? +my $type = ''; +my @excludes = (); +my @move = (); +my %renamed = (); +my $opt_debsdir; + +# handle command-line options + +while (@ARGV) { + if ($ARGV[0] =~ /^(--help|-h)$/) { usage(); exit 0; } + if ($ARGV[0] =~ /^(--version|-v)$/) { print $version; exit 0; } + if ($ARGV[0] =~ /^(--move(-regex)?|-m)$/) { + fatal +"Malformed command-line option $ARGV[0]; run $progname --help for more info" + unless @ARGV >= 3; + + my $regex = $ARGV[0] eq '--move-regex' ? 1 : 0; + shift @ARGV; + + # Ensure from and to values all begin with a slash + # dpkg -c produces filenames such as ./usr/lib/filename + my $from = shift; + my $to = shift; + $from =~ s%^\./%/%; + $to =~ s%^\./%/%; + + if ($regex) { + # quote ':' in the from and to patterns; + # used later as a pattern delimiter + $from =~ s/:/\\:/g; + $to =~ s/:/\\:/g; + } + push @move, [$regex, $from, $to]; + } elsif ($ARGV[0] eq '--renamed') { + fatal +"Malformed command-line option $ARGV[0]; run $progname --help for more info" + unless @ARGV >= 3; + shift @ARGV; + + my $from = shift; + my $to = shift; + $renamed{$from} = $to; + } elsif ($ARGV[0] eq '--exclude') { + fatal +"Malformed command-line option $ARGV[0]; run $progname --help for more info" + unless @ARGV >= 2; + shift @ARGV; + + my $exclude = shift; + push @excludes, $exclude; + } elsif ($ARGV[0] =~ s/^--exclude=//) { + my $exclude = shift; + push @excludes, $exclude; + } elsif ($ARGV[0] eq '--controlfiles') { + fatal +"Malformed command-line option $ARGV[0]; run $progname --help for more info" + unless @ARGV >= 2; + shift @ARGV; + + $controlfiles = shift; + } elsif ($ARGV[0] =~ s/^--controlfiles=//) { + $controlfiles = shift; + } elsif ($ARGV[0] eq '--debs-dir') { + fatal +"Malformed command-line option $ARGV[0]; run $progname --help for more info" + unless @ARGV >= 2; + shift @ARGV; + + $opt_debsdir = shift; + } elsif ($ARGV[0] =~ s/^--debs-dir=//) { + $opt_debsdir = shift; + } elsif ($ARGV[0] =~ /^(--dirs|-d)$/) { + $ignore_dirs = 0; + shift; + } elsif ($ARGV[0] eq '--nodirs') { + $ignore_dirs = 1; + shift; + } elsif ($ARGV[0] =~ /^(--quiet|-q)$/) { + $quiet = 1; + shift; + } elsif ($ARGV[0] =~ /^(--show-moved|-s)$/) { + $show_moved = 1; + shift; + } elsif ($ARGV[0] eq '--noshow-moved') { + $show_moved = 0; + shift; + } elsif ($ARGV[0] eq '--nocontrol') { + $compare_control = 0; + shift; + } elsif ($ARGV[0] eq '--control') { + $compare_control = 1; + shift; + } elsif ($ARGV[0] eq '--from') { + $type = 'debs'; + last; + } elsif ($ARGV[0] =~ /^--w([plt])$/) { + $wdiff_opt = "-$1"; + shift; + } elsif ($ARGV[0] =~ /^(--ignore-space|-w)$/) { + push @diff_opts, "-w"; + shift; + } elsif ($ARGV[0] eq '--diffstat') { + $show_diffstat = 1; + shift; + } elsif ($ARGV[0] =~ /^--no-?diffstat$/) { + $show_diffstat = 0; + shift; + } elsif ($ARGV[0] eq '--wdiff-source-control') { + $wdiff_source_control = 1; + shift; + } elsif ($ARGV[0] =~ /^--no-?wdiff-source-control$/) { + $wdiff_source_control = 0; + shift; + } elsif ($ARGV[0] eq '--auto-ver-sort') { + $auto_ver_sort = 1; + shift; + } elsif ($ARGV[0] =~ /^--no-?auto-ver-sort$/) { + $auto_ver_sort = 0; + shift; + } elsif ($ARGV[0] eq '--unpack-tarballs') { + $unpack_tarballs = 1; + shift; + } elsif ($ARGV[0] =~ /^--no-?unpack-tarballs$/) { + $unpack_tarballs = 0; + shift; + } elsif ($ARGV[0] =~ /^--no-?conf$/) { + fatal "--no-conf is only acceptable as the first command-line option!"; + } + + # Not a recognised option + elsif ($ARGV[0] =~ /^-/) { + fatal +"Unrecognised command-line option $ARGV[0]; run $progname --help for more info"; + } else { + # End of command line options + last; + } +} + +for my $exclude (@excludes) { + if ($exclude =~ m{/}) { + print STDERR +"$progname: warning: --exclude patterns are matched against the basename, so --exclude='$exclude' will not exclude anything\n"; + } +} + +my $guessed_version = 0; + +if ($opt_debsdir) { + $opt_debsdir =~ s%^/+%/%; + $opt_debsdir =~ s%(.)/$%$1%; + $debsdir_warning = "--debs-dir directory $opt_debsdir does not exist!"; + $debsdir = $opt_debsdir; +} + +# If no file is given, assume that we are in a source directory +# and try to create a diff with the previous version +if (@ARGV == 0) { + my $namepat = qr/[-+0-9a-z.]/i; + + fatal $debsdir_warning unless -d $debsdir; + + fatal "Can't read file: debian/changelog" unless -r "debian/changelog"; + open CHL, "debian/changelog"; + while () { + if (/^(\w$namepat*)\s\((\d+:)?(.+)\)((\s+$namepat+)+)\;\surgency=.+$/) + { + unshift @ARGV, $debsdir . "/" . $1 . "_" . $3 . ".dsc"; + $guessed_version++; + } + last if $guessed_version > 1; + } + close CHL; +} + +if (!$type) { + # we need 2 deb files or changes files to compare + fatal "Need exactly two deb files or changes files to compare" + unless @ARGV == 2; + + foreach my $i (0, 1) { + fatal "Can't read file: $ARGV[$i]" unless -r $ARGV[$i]; + } + + if ($ARGV[0] =~ /\.deb$/) { $type = 'deb'; } + elsif ($ARGV[0] =~ /\.udeb$/) { $type = 'deb'; } + elsif ($ARGV[0] =~ /\.changes$/) { $type = 'changes'; } + elsif ($ARGV[0] =~ /\.dsc$/) { $type = 'dsc'; } + else { + fatal +"Could not recognise files; the names should end .deb, .udeb, .changes or .dsc"; + } + if ($ARGV[1] !~ /\.$type$/ && ($type ne 'deb' || $ARGV[1] !~ /\.udeb$/)) { + fatal +"The two filenames must have the same suffix, either .deb, .udeb, .changes or .dsc"; + } +} + +# We collect up the individual deb information in the hashes +# %debs1 and %debs2, each key of which is a .deb name and each value is +# a list ref. Note we need to use our, not my, as we will be symbolically +# referencing these variables +my @CommonDebs = (); +my @singledeb; +our ( + %debs1, %debs2, %files1, %files2, @D1, + @D2, $dir1, $dir2, %DebPaths1, %DebPaths2 +); + +if ($type eq 'deb') { + no strict 'refs'; + foreach my $i (1, 2) { + my $deb = shift; + my ($debc, $debI) = ('', ''); + my %dpkg_env = (LC_ALL => 'C'); + eval { + spawn( + exec => ['dpkg-deb', '-c', $deb], + env => \%dpkg_env, + to_string => \$debc, + wait_child => 1 + ); + }; + if ($@) { + fatal "dpkg-deb -c $deb failed!"; + } + + eval { + spawn( + exec => ['dpkg-deb', '-I', $deb], + env => \%dpkg_env, + to_string => \$debI, + wait_child => 1 + ); + }; + if ($@) { + fatal "dpkg-deb -I $deb failed!"; + } + # Store the name for later + $singledeb[$i] = $deb; + # get package name itself + $deb =~ s,.*/,,; + $deb =~ s/_.*//; + @{"D$i"} = @{ process_debc($debc, $i) }; + push @{"D$i"}, @{ process_debI($debI) }; + } +} elsif ($type eq 'changes' or $type eq 'debs') { + # Have to parse .changes files or remaining arguments + my $pwd = cwd; + foreach my $i (1, 2) { + my (@debs) = (); + if ($type eq 'debs') { + if (@ARGV < 2) { + # Oops! There should be at least --from|--to deb ... + fatal +"Missing .deb names or missing --to! (Run debdiff -h for help)\n"; + } + shift; # get rid of --from or --to + while (@ARGV and $ARGV[0] ne '--to') { + push @debs, shift; + } + + # Is there only one .deb listed? + if (@debs == 1) { + $singledeb[$i] = $debs[0]; + } + } else { + my $changes = shift; + open CHANGES, $changes + or fatal "Couldn't open $changes: $!"; + my $infiles = 0; + while () { + last if $infiles and /^[^ ]/; + /^Files:/ and $infiles = 1, next; + next unless $infiles; + if (/ (\S*.u?deb)$/) { + my $file = $1; + $file !~ m,[/\x00], + or fatal "File name contains invalid characters: $file"; + push @debs, dirname($changes) . '/' . $file; + } + } + close CHANGES + or fatal "Problem reading $changes: $!"; + + # Is there only one .deb listed? + if (@debs == 1) { + $singledeb[$i] = $debs[0]; + } + } + + foreach my $deb (@debs) { + no strict 'refs'; + fatal "Can't read file: $deb" unless -r $deb; + my ($debc, $debI) = ('', ''); + my %dpkg_env = (LC_ALL => 'C'); + eval { + spawn( + exec => ['dpkg-deb', '-c', $deb], + to_string => \$debc, + env => \%dpkg_env, + wait_child => 1 + ); + }; + if ($@) { + fatal "dpkg-deb -c $deb failed!"; + } + eval { + spawn( + exec => ['dpkg-deb', '-I', $deb], + to_string => \$debI, + env => \%dpkg_env, + wait_child => 1 + ); + }; + if ($@) { + fatal "dpkg-deb -I $deb failed!"; + } + my $debpath = $deb; + # get package name itself + $deb =~ s,.*/,,; + $deb =~ s/_.*//; + $deb = $renamed{$deb} if $i == 1 and exists $renamed{$deb}; + if (exists ${"debs$i"}{$deb}) { + warn +"Same package name appears more than once (possibly due to renaming): $deb\n"; + } else { + ${"debs$i"}{$deb} = 1; + } + ${"DebPaths$i"}{$deb} = $debpath; + foreach my $file (@{ process_debc($debc, $i) }) { + ${"files$i"}{$file} ||= ""; + ${"files$i"}{$file} .= "$deb:"; + } + foreach my $control (@{ process_debI($debI) }) { + ${"files$i"}{$control} ||= ""; + ${"files$i"}{$control} .= "$deb:"; + } + } + no strict 'refs'; + @{"D$i"} = keys %{"files$i"}; + # Go back again + chdir $pwd or fatal "Couldn't chdir $pwd: $!"; + } +} elsif ($type eq 'dsc') { + # Compare source packages + my $pwd = cwd; + + my (@origs, @diffs, @dscs, @dscformats, @versions); + foreach my $i (1, 2) { + my $dsc = shift; + chdir dirname($dsc) + or fatal "Couldn't chdir ", dirname($dsc), ": $!"; + + $dscs[$i] = cwd() . '/' . basename($dsc); + + open DSC, basename($dsc) or fatal "Couldn't open $dsc: $!"; + + my $infiles = 0; + while () { + if (/^Files:/) { + $infiles = 1; + next; + } elsif (/^Format: (.*)$/) { + $dscformats[$i] = $1; + } elsif (/^Version: (.*)$/) { + $versions[$i - 1] = [$1, $i]; + } + next unless $infiles; + last if /^\s*$/; + last if /^[-\w]+:/; # don't expect this, but who knows? + chomp; + + # This had better match + if (/^\s+[0-9a-f]{32}\s+\d+\s+(\S+)$/) { + my $file = $1; + $file !~ m,[/\x00], + or fatal "File name contains invalid characters: $file"; + if ($file =~ /\.diff\.gz$/) { + $diffs[$i] = cwd() . '/' . $file; + } elsif ($file =~ /((?:\.orig)?\.tar\.$compression_re|\.git)$/) + { + $origs[$i] = $file; + } + } else { + warn "Unrecognised file line in .dsc:\n$_\n"; + } + } + + close DSC or fatal "Problem closing $dsc: $!"; + # Go back again + chdir $pwd or fatal "Couldn't chdir $pwd: $!"; + } + + @versions = Devscripts::Versort::versort(@versions); + # If the versions are currently out of order, should we swap them? + if ( $auto_ver_sort + and !$guessed_version + and $versions[0][1] == 1 + and $versions[0][0] ne $versions[1][0]) { + foreach my $var ((\@origs, \@diffs, \@dscs, \@dscformats)) { + my $temp = @{$var}[1]; + @{$var}[1] = @{$var}[2]; + @{$var}[2] = $temp; + } + } + + # Do we have interdiff? + system("command -v interdiff >/dev/null 2>&1"); + my $use_interdiff = ($? == 0) ? 1 : 0; + system("command -v diffstat >/dev/null 2>&1"); + my $have_diffstat = ($? == 0) ? 1 : 0; + system("command -v wdiff >/dev/null 2>&1"); + my $have_wdiff = ($? == 0) ? 1 : 0; + + my ($fh, $filename) = tempfile( + "debdiffXXXXXX", + SUFFIX => ".diff", + DIR => File::Spec->tmpdir, + UNLINK => 1 + ); + + # When wdiffing source control files we always fully extract both source + # packages as it's the easiest way of getting the debian/control file, + # particularly if the orig tar ball contains one which is patched in the + # diffs + if ( $origs[1] eq $origs[2] + and defined $diffs[1] + and defined $diffs[2] + and scalar(@excludes) == 0 + and $use_interdiff + and !$wdiff_source_control) { + # same orig tar ball, interdiff exists and not wdiffing + + my $tmpdir = tempdir(CLEANUP => 1); + eval { + spawn( + exec => ['interdiff', '-z', @diff_opts, $diffs[1], $diffs[2]], + to_file => $filename, + wait_child => 1, + # Make interdiff put its tempfiles in $tmpdir, so they're + # automatically cleaned up + env => { TMPDIR => $tmpdir }); + }; + + # If interdiff fails for some reason, we'll fall back to our manual + # diffing. + unless ($@) { + if ($have_diffstat and $show_diffstat) { + my $header + = "diffstat for " + . basename($diffs[1]) . " " + . basename($diffs[2]) . "\n\n"; + $header =~ s/\.diff\.gz//g; + print $header; + spawn( + exec => ['diffstat', $filename], + wait_child => 1 + ); + print "\n"; + } + + if (-s $filename) { + open(INTERDIFF, '<', $filename); + while () { + print $_; + } + close INTERDIFF; + + $exit_status = 1; + } + exit $exit_status; + } + } + + # interdiff ran and failed, or any other situation + if (!$use_interdiff) { + warn +"Warning: You do not seem to have interdiff (in the patchutils package)\ninstalled; this program would use it if it were available.\n"; + } + # possibly different orig tarballs, or no interdiff installed, + # or wdiffing debian/control + our ($sdir1, $sdir2); + mktmpdirs(); + for my $i (1, 2) { + no strict 'refs'; + my @opts = ('-x'); + push(@opts, '--skip-patches') if $dscformats[$i] eq '3.0 (quilt)'; + my $diri = ${"dir$i"}; + eval { + spawn( + exec => ['dpkg-source', @opts, $dscs[$i]], + to_file => '/dev/null', + chdir => $diri, + wait_child => 1 + ); + }; + if ($@) { + my $dir = dirname $dscs[1] if $i == 2; + $dir = dirname $dscs[2] if $i == 1; + cp "$dir/$origs[$i]", + $diri || fatal "copy $dir/$origs[$i] $diri: $!"; + my $dscx = basename $dscs[$i]; + cp $diffs[$i], $diri || fatal "copy $diffs[$i] $diri: $!"; + cp $dscs[$i], $diri || fatal "copy $dscs[$i] $diri: $!"; + spawn( + exec => ['dpkg-source', @opts, $dscx], + to_file => '/dev/null', + chdir => $diri, + wait_child => 1 + ); + } + opendir DIR, $diri; + while ($_ = readdir(DIR)) { + next if $_ eq '.' || $_ eq '..' || !-d "$diri/$_"; + ${"sdir$i"} = $_; + last; + } + closedir(DIR); + my $sdiri = ${"sdir$i"}; + +# also unpack tarballs found in the top level source directory so we can compare their contents too + next unless $unpack_tarballs; + opendir DIR, $diri . '/' . $sdiri; + + my $tarballs = 1; + while ($_ = readdir(DIR)) { + my $unpacked = "=unpacked-tar" . $tarballs . "="; + my $filename = $_; + if ($filename =~ s/\.tar\.$compression_re$//) { + my $comp = compression_guess_from_filename($_); + $tarballs++; + spawn( + exec => ['tar', "--$comp", '-xf', $_], + to_file => '/dev/null', + wait_child => 1, + chdir => "$diri/$sdiri", + nocheck => 1 + ); + if (-d "$diri/$sdiri/$filename") { + move "$diri/$sdiri/$filename", "$diri/$sdiri/$unpacked"; + } + } + } + closedir(DIR); + } + + my @command = ("diff", "-Nru", @diff_opts); + for my $exclude (@excludes) { + push @command, ("--exclude", $exclude); + } + push @command, ("$dir1/$sdir1", "$dir2/$sdir2"); + +# Execute diff and remove the common prefixes $dir1/$dir2, so the patch can be used with -p1, +# as if when interdiff would have been used: + spawn( + exec => \@command, + to_file => $filename, + wait_child => 1, + nocheck => 1 + ); + + if ($have_diffstat and $show_diffstat) { + print "diffstat for $sdir1 $sdir2\n\n"; + spawn( + exec => ['diffstat', $filename], + wait_child => 1 + ); + print "\n"; + } + + if ($have_wdiff and $wdiff_source_control) { + # Abuse global variables slightly to create some temporary directories + my $tempdir1 = $dir1; + my $tempdir2 = $dir2; + mktmpdirs(); + our $wdiffdir1 = $dir1; + our $wdiffdir2 = $dir2; + $dir1 = $tempdir1; + $dir2 = $tempdir2; + our @cf; + + if ($controlfiles eq 'ALL') { + @cf = ('control'); + } else { + @cf = split /,/, $controlfiles; + } + + no strict 'refs'; + for my $i (1, 2) { + foreach my $file (@cf) { + cp ${"dir$i"} . '/' . ${"sdir$i"} . "/debian/$file", + ${"wdiffdir$i"}; + } + } + use strict 'refs'; + + # We don't support "ALL" for source packages as that would + # wdiff debian/* + $exit_status = wdiff_control_files($wdiffdir1, $wdiffdir2, $dummyname, + $controlfiles eq 'ALL' ? 'control' : $controlfiles, $exit_status); + print "\n"; + + # Clean up + rmtree([$wdiffdir1, $wdiffdir2]); + } + + if (!-f $filename) { + fatal "Creation of diff file $filename failed!"; + } elsif (-s $filename) { + open(DIFF, '<', $filename) + or fatal "Opening diff file $filename failed!"; + + while () { + s/^--- $dir1\//--- /; + s/^\+\+\+ $dir2\//+++ /; + s/^(diff .*) $dir1\/\Q$sdir1\E/$1 $sdir1/; + s/^(diff .*) $dir2\/\Q$sdir2\E/$1 $sdir2/; + print; + } + close DIFF; + + $exit_status = 1; + } + + exit $exit_status; +} else { + fatal "Internal error: \$type = $type unrecognised"; +} + +# Compare +# Start by a piece of common code to set up the @CommonDebs list and the like + +my (@deblosses, @debgains); + +{ + my %debs; + grep $debs{$_}--, keys %debs1; + grep $debs{$_}++, keys %debs2; + + @deblosses = sort grep $debs{$_} < 0, keys %debs; + @debgains = sort grep $debs{$_} > 0, keys %debs; + @CommonDebs = sort grep $debs{$_} == 0, keys %debs; +} + +if ($show_moved and $type ne 'deb') { + if (@debgains) { + my $msg + = "Warning: these package names were in the second list but not in the first:"; + print $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @debgains), "\n\n"; + } + + if (@deblosses) { + print "\n" if @debgains; + my $msg + = "Warning: these package names were in the first list but not in the second:"; + print $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @deblosses), "\n\n"; + } + + # We start by determining which files are in the first set of debs, the + # second set of debs or both. + my %files; + grep $files{$_}--, @D1; + grep $files{$_}++, @D2; + + my @old = sort grep $files{$_} < 0, keys %files; + my @new = sort grep $files{$_} > 0, keys %files; + my @same = sort grep $files{$_} == 0, keys %files; + + # We store any changed files in a hash of hashes %changes, where + # $changes{$from}{$to} is an array of files which have moved + # from package $from to package $to; $from or $to is '-' if + # the files have appeared or disappeared + + my %changes; + my @funny; # for storing changed files which appear in multiple debs + + foreach my $file (@old) { + my @firstdebs = split /:/, $files1{$file}; + foreach my $firstdeb (@firstdebs) { + push @{ $changes{$firstdeb}{'-'} }, $file; + } + } + + foreach my $file (@new) { + my @seconddebs = split /:/, $files2{$file}; + foreach my $seconddeb (@seconddebs) { + push @{ $changes{'-'}{$seconddeb} }, $file; + } + } + + foreach my $file (@same) { + # Are they identical? + next if $files1{$file} eq $files2{$file}; + + # Ah, they're not the same. If the file has moved from one deb + # to another, we'll put a note in that pair. But if the file + # was in more than one deb or ends up in more than one deb, we'll + # list it separately. + my @fdebs1 = split(/:/, $files1{$file}); + my @fdebs2 = split(/:/, $files2{$file}); + + if (@fdebs1 == 1 && @fdebs2 == 1) { + push @{ $changes{ $fdebs1[0] }{ $fdebs2[0] } }, $file; + } else { + # two packages to one or vice versa, or something like that + push @funny, [$file, \@fdebs1, \@fdebs2]; + } + } + + # This is not a very efficient way of doing things if there are + # lots of debs involved, but since that is highly unlikely, it + # shouldn't be much of an issue + my $changed = 0; + + for my $deb1 (sort(keys %debs1), '-') { + next unless exists $changes{$deb1}; + for my $deb2 ('-', sort keys %debs2) { + next unless exists $changes{$deb1}{$deb2}; + my $msg; + if (!$changed) { + print +"[The following lists of changes regard files as different if they have\ndifferent names, permissions or owners.]\n\n"; + } + if ($deb1 eq '-') { + $msg + = "New files in second set of .debs, found in package $deb2"; + } elsif ($deb2 eq '-') { + $msg + = "Files only in first set of .debs, found in package $deb1"; + } else { + $msg = "Files moved from package $deb1 to package $deb2"; + } + print $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @{ $changes{$deb1}{$deb2} }), "\n\n"; + $changed = 1; + } + } + + if (@funny) { + my $msg + = "Files moved or copied from at least TWO packages or to at least TWO packages"; + print $msg, "\n", '-' x length $msg, "\n"; + for my $funny (@funny) { + print $$funny[0], "\n"; # filename and details + print "From package", (@{ $$funny[1] } > 1 ? "s" : ""), ": "; + print join(", ", @{ $$funny[1] }), "\n"; + print "To package", (@{ $$funny[2] } > 1 ? "s" : ""), ": "; + print join(", ", @{ $$funny[2] }), "\n"; + } + $changed = 1; + } + + if (!$quiet && !$changed) { + print + "File lists identical on package level (after any substitutions)\n"; + } + $exit_status = 1 if $changed; +} else { + my %files; + grep $files{$_}--, @D1; + grep $files{$_}++, @D2; + + my @losses = sort grep $files{$_} < 0, keys %files; + my @gains = sort grep $files{$_} > 0, keys %files; + + if (@losses == 0 && @gains == 0) { + print "File lists identical (after any substitutions)\n" + unless $quiet; + } else { + print +"[The following lists of changes regard files as different if they have\ndifferent names, permissions or owners.]\n\n"; + } + + if (@gains) { + my $msg; + if ($type eq 'debs') { + $msg = "Files in second set of .debs but not in first"; + } else { + $msg = sprintf "Files in second .%s but not in first", + $type eq 'deb' ? 'deb' : 'changes'; + } + print $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @gains), "\n"; + $exit_status = 1; + } + + if (@losses) { + print "\n" if @gains; + my $msg; + if ($type eq 'debs') { + $msg = "Files in first set of .debs but not in second"; + } else { + $msg = sprintf "Files in first .%s but not in second", + $type eq 'deb' ? 'deb' : 'changes'; + } + print $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @losses), "\n"; + $exit_status = 1; + } +} + +# We compare the control files (at least the dependency fields) +if (defined $singledeb[1] and defined $singledeb[2]) { + @CommonDebs = ($dummyname); + $DebPaths1{$dummyname} = $singledeb[1]; + $DebPaths2{$dummyname} = $singledeb[2]; +} + +exit $exit_status unless (@CommonDebs > 0) and $compare_control; + +unless (system("command -v wdiff >/dev/null 2>&1") == 0) { + warn "Can't compare control files; wdiff package not installed\n"; + exit $exit_status; +} + +for my $debname (@CommonDebs) { + no strict 'refs'; + mktmpdirs(); + + for my $i (1, 2) { + my $debpath = "${\"DebPaths$i\"}{$debname}"; + my $diri = ${"dir$i"}; + eval { + spawn( + exec => ['dpkg-deb', '-e', $debpath, $diri], + wait_child => 1 + ); + }; + if ($@) { + my $msg = "dpkg-deb -e ${\"DebPaths$i\"}{$debname} failed!"; + rmtree([$dir1, $dir2]); + fatal $msg; + } + } + + use strict 'refs'; + $exit_status = wdiff_control_files($dir1, $dir2, $debname, $controlfiles, + $exit_status); + + # Clean up + rmtree([$dir1, $dir2]); +} + +exit $exit_status; + +###### Subroutines + +# This routine takes the output of dpkg-deb -c and returns +# a processed listref +sub process_debc($$) { + my ($data, $number) = @_; + my (@filelist); + + # Format of dpkg-deb -c output: + # permissions owner/group size date time name ['->' link destination] + $data =~ s/^(\S+)\s+(\S+)\s+(\S+\s+){3}/$1 $2 /mg; + $data =~ s, \./, /,mg; + @filelist = grep !m| /$|, split /\n/, $data; # don't bother keeping '/' + + # Are we keeping directory names in our filelists? + if ($ignore_dirs) { + @filelist = grep !m|/$|, @filelist; + } + + # Do the "move" substitutions in the order received for the first debs + if ($number == 1 and @move) { + my @split_filelist + = map { m/^(\S+) (\S+) (.*)/ && [$1, $2, $3] } @filelist; + for my $move (@move) { + my $regex = $$move[0]; + my $from = $$move[1]; + my $to = $$move[2]; + map { + if ($regex) { eval "\$\$_[2] =~ s:$from:$to:g"; } + else { $$_[2] =~ s/\Q$from\E/$to/; } + } @split_filelist; + } + @filelist = map { "$$_[0] $$_[1] $$_[2]" } @split_filelist; + } + + return \@filelist; +} + +# This does the same for dpkg-deb -I +sub process_debI($) { + my ($data) = @_; + my (@filelist); + + # Format of dpkg-deb -c output: + # 2 (always?) header lines + # nnnn bytes, nnn lines [*] filename [interpreter] + # Package: ... + # rest of control file + + foreach (split /\n/, $data) { + last if /^Package:/; + next unless /^\s+\d+\s+bytes,\s+\d+\s+lines\s+(\*)?\s+([\-\w]+)/; + my $control = $2; + my $perms = ($1 ? "-rwxr-xr-x" : "-rw-r--r--"); + push @filelist, "$perms root/root DEBIAN/$control"; + } + + return \@filelist; +} + +sub wdiff_control_files($$$$$) { + my ($dir1, $dir2, $debname, $controlfiles, $origstatus) = @_; + return + unless defined $dir1 + and defined $dir2 + and defined $debname + and defined $controlfiles; + my @cf; + my $status = $origstatus; + if ($controlfiles eq 'ALL') { + # only need to list one directory as we are only comparing control + # files in both packages + @cf = grep { !/md5sums/ } map { basename($_); } glob("$dir1/*"); + } else { + @cf = split /,/, $controlfiles; + } + + foreach my $cf (@cf) { + next unless -f "$dir1/$cf" and -f "$dir2/$cf"; + if ($cf eq 'control' or $cf eq 'conffiles' or $cf eq 'shlibs') { + for my $file ("$dir1/$cf", "$dir2/$cf") { + my ($fd, @hdrs); + open $fd, '<', $file or fatal "Cannot read $file: $!"; + while (<$fd>) { + if (/^\s/ and @hdrs > 0) { + $hdrs[$#hdrs] .= $_; + } else { + push @hdrs, $_; + } + } + close $fd; + chmod 0644, $file; + open $fd, '>', $file or fatal "Cannot write $file: $!"; + print $fd sort @hdrs; + close $fd; + } + } + my $usepkgname = $debname eq $dummyname ? "" : " of package $debname"; + my @opts = ('-n'); + push @opts, $wdiff_opt if $wdiff_opt; + my ($wdiff, $wdiff_error) = ('', ''); + spawn( + exec => ['wdiff', @opts, "$dir1/$cf", "$dir2/$cf"], + to_string => \$wdiff, + error_to_string => \$wdiff_error, + wait_child => 1, + nocheck => 1 + ); + if ($? && ($? >> 8) != 1) { + print "$wdiff_error\n"; + warn "wdiff failed\n"; + } else { + if (!$?) { + if (!$quiet) { + print +"\nNo differences were encountered between the $cf files$usepkgname\n"; + } + } elsif ($wdiff_opt) { + # Don't try messing with control codes + my $msg = ucfirst($cf) . " files$usepkgname: wdiff output"; + print "\n", $msg, "\n", '-' x length $msg, "\n"; + print $wdiff; + $status = 1; + } else { + my @output; + @output = split /\n/, $wdiff; + @output = grep /(\[-|\{\+)/, @output; + my $msg = ucfirst($cf) + . " files$usepkgname: lines which differ (wdiff format)"; + print "\n", $msg, "\n", '-' x length $msg, "\n"; + print join("\n", @output), "\n"; + $status = 1; + } + } + } + + return $status; +} + +sub mktmpdirs () { + no strict 'refs'; + + for my $i (1, 2) { + ${"dir$i"} = tempdir(CLEANUP => 1); + fatal "Couldn't create temp directory" + if not defined ${"dir$i"}; + } +} + +sub fatal(@) { + my ($pack, $file, $line); + ($pack, $file, $line) = caller(); + (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d; + $msg =~ s/\n\n$/\n/; + die $msg; +} diff --git a/scripts/debi.1 b/scripts/debi.1 new file mode 100644 index 0000000..779462a --- /dev/null +++ b/scripts/debi.1 @@ -0,0 +1,140 @@ +.TH DEBI 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debi \- install current version of generated Debian package +.SH SYNOPSIS +\fBdebi\fP [\fIoptions\fR] [\fIchanges file\fR] [\fIpackage\fR ...] +.SH DESCRIPTION +\fBdebi\fR figures out the current version of a package and installs +it. If a \fI.changes\fR file is specified on the command line, the +filename must end with \fI.changes\fR, as this is how the program +distinguishes it from package names. If not, then \fBdebi\fR has to +be called from within the source code directory tree. In this case, +it will look for the \fI.changes\fR file corresponding to the current +package version (by determining the name and version number from the +changelog, and the architecture in the same way as +\fBdpkg-buildpackage\fR(1) does). It then runs \fBdebpkg \-i\fR on +every \fI.deb\fR archive listed in the \fI.changes\fR file to install +them, assuming that all of the \fI.deb\fR archives live in the same +directory as the \fI.changes\fR file. Note that you probably don't +want to run this program on a \fI.changes\fR file relating to a +different architecture after cross-compiling the package! +.PP +If a list of packages is given on the command line, then only those +debs with names in this list of packages will be installed. +.PP +Since installing a package requires root privileges, \fBdebi\fR calls +\fBdebpkg\fR rather than \fBdpkg\fR directly. Thus \fBdebi\fR will +only be useful if it is either being run as root or \fBdebpkg\fR can +be run as root. See \fBdebpkg\fR(1) for more details. +.SH "Directory name checking" +In common with several other scripts in the \fBdevscripts\fR package, +\fBdebi\fR will climb the directory tree until it finds a +\fIdebian/changelog\fR file. As a safeguard against stray files +causing potential problems, it will examine the name of the parent +directory once it finds the \fIdebian/changelog\fR file, and check +that the directory name corresponds to the package name. Precisely +how it does this is controlled by two configuration file variables +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR and \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR, and +their corresponding command-line options \fB\-\-check-dirname-level\fR +and \fB\-\-check-dirname-regex\fR. +.PP +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR can take the following values: +.TP +.B 0 +Never check the directory name. +.TP +.B 1 +Only check the directory name if we have had to change directory in +our search for \fIdebian/changelog\fR. This is the default behaviour. +.TP +.B 2 +Always check the directory name. +.PP +The directory name is checked by testing whether the current directory +name (as determined by \fBpwd\fR(1)) matches the regex given by the +configuration file option \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR or by the +command line option \fB\-\-check-dirname-regex\fR \fIregex\fR. Here +\fIregex\fR is a Perl regex (see \fBperlre\fR(3perl)), which will be +anchored at the beginning and the end. If \fIregex\fR contains a '/', +then it must match the full directory path. If not, then it must +match the full directory name. If \fIregex\fR contains the string +\'PACKAGE', this will be replaced by the source package name, as +determined from the changelog. The default value for the regex is: +\'PACKAGE(-.+)?', thus matching directory names such as PACKAGE and +PACKAGE-version. +.SH OPTIONS +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. +.TP +\fB\-\-debs\-dir\fR \fIdirectory\fR +Look for the \fI.changes\fR and \fI.deb\fR files in \fIdirectory\fR +instead of the parent of the source directory. This should +either be an absolute path or relative to the top of the source +directory. +.TP +.BR \-m ", " \-\-multi +Search for a multiarch \fI.changes\fR file, as created by \fBdpkg-cross\fR. +.TP +.BR \-u ", " \-\-upgrade +Only upgrade packages already installed on the system, rather than +installing all packages listed in the \fI.changes\fR file. +Useful for multi-binary packages when you don't want to have all the +binaries installed at once. +.TP +\fB\-\-check-dirname-level\fR \fIN\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-check-dirname-regex\fR \fIregex\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-with-depends\fR +Attempt to satisfy the \fIDepends\fR of a package when installing it. +.TP +\fB\-\-tool\fR \fItool\fR +Use the specified \fItool\fR for installing the dependencies of the package(s) to be +installed. By default, \fBapt-get\fR is used. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +\fB\-\-help\fR, \fB\-\-version\fR +Show help message and version information respectively. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced in that order to set configuration +variables. Command line options can be used to override configuration +file settings. Environment variable settings are ignored for this +purpose. The currently recognised variables are: +.TP +.B DEBRELEASE_DEBS_DIR +This specifies the directory in which to look for the \fI.changes\fR +and \fI.deb\fR files, and is either an absolute path or relative to +the top of the source tree. This corresponds to the +\fB\-\-debs\-dir\fR command line option. This directive could be +used, for example, if you always use \fBpbuilder\fR or +\fBsvn-buildpackage\fR to build your packages. Note that it also +affects \fBdebrelease\fR(1) in the same way, hence the strange name of +the option. +.TP +.BR DEVSCRIPTS_CHECK_DIRNAME_LEVEL ", " DEVSCRIPTS_CHECK_DIRNAME_REGEX +See the above section \fBDirectory name checking\fR for an explanation of +these variables. Note that these are package-wide configuration +variables, and will therefore affect all \fBdevscripts\fR scripts +which check their value, as described in their respective manpages and +in \fBdevscripts.conf\fR(5). +.SH "SEE ALSO" +.BR debpkg (1), +.BR devscripts.conf (5) +.SH AUTHOR +\fBdebi\fR was originally written by Christoph Lameter +. The now-defunct script \fBdebit\fR was +originally written by James R. Van Zandt . They +have been moulded into one script together with \fBdebc\fR(1) and +parts extensively modified by Julian Gilbey . diff --git a/scripts/debi.bash_completion b/scripts/debi.bash_completion new file mode 100644 index 0000000..4fa10df --- /dev/null +++ b/scripts/debi.bash_completion @@ -0,0 +1,23 @@ +# /usr/share/bash-completion/completions/debi +# Bash command completion for ‘debi(1)’. +# Documentation: ‘bash(1)’, section “Programmable Completion”. + +_debc() +{ + local cur + cur="${COMP_WORDS[COMP_CWORD]}" + COMPREPLY=($(compgen -f -X '!*.changes' -- "$cur")) + if echo "$cur" | grep -qs '^[a-z0-9+.-]*$'; then + COMPREPLY=(${COMPREPLY[@]} $(apt-cache pkgnames -- $cur 2> /dev/null)) + fi + return 0 +} +complete -o dirnames -F _debc debc debi + + +# Local variables: +# coding: utf-8 +# mode: shell-script +# indent-tabs-mode: nil +# End: +# vim: fileencoding=utf-8 filetype=sh expandtab shiftwidth=4 : diff --git a/scripts/debi.pl b/scripts/debi.pl new file mode 100755 index 0000000..6d0d53a --- /dev/null +++ b/scripts/debi.pl @@ -0,0 +1,477 @@ +#!/usr/bin/perl + +# debi: Install current version of deb package +# debc: List contents of current version of deb package +# +# debi and debc originally by Christoph Lameter +# Copyright Christoph Lameter +# The now defunct debit originally by Jim Van Zandt +# Copyright 1999 Jim Van Zandt +# Modifications by Julian Gilbey , 1999-2003 +# Copyright 1999-2003, Julian Gilbey +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +use 5.008; +use strict; +use warnings; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use File::Basename; +use filetest 'access'; +use Cwd; +use Dpkg::Control; +use Dpkg::Changelog::Parse qw(changelog_parse); +use Dpkg::IPC; + +my $progname = basename($0, '.pl'); # the '.pl' is for when we're debugging +my $modified_conf_msg; + +sub usage_i { + print <<"EOF"; +Usage: $progname [options] [.changes file] [package ...] + Install the .deb file(s) just created, as listed in the generated + .changes file or the .changes file specified. If packages are listed, + only install those specified packages from the .changes file. + Options: + --no-conf or Don\'t read devscripts config files; + --noconf must be the first option given + -a Search for .changes file made for Debian build + -t Search for .changes file made for GNU arch + --debs-dir DIR Look for the changes and debs files in DIR instead of + the parent of the current package directory + --multi Search for multiarch .changes file made by dpkg-cross + --upgrade Only upgrade packages; don't install new ones. + --check-dirname-level N + How much to check directory names: + N=0 never + N=1 only if program changes directory (default) + N=2 always + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE\' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + --with-depends Install packages with their depends. + --tool TOOL Use the specified tool for installing the dependencies + of the package(s) to be installed. + (default: apt-get) + --help Show this message + --version Show version and copyright information + +Default settings modified by devscripts configuration files: +$modified_conf_msg +EOF +} + +sub usage_c { + print <<"EOF"; +Usage: $progname [options] [.changes file] [package ...] + Display the contents of the .deb or .udeb file(s) just created, as listed + in the generated .changes file or the .changes file specified. + If packages are listed, only display those specified packages + from the .changes file. Options: + --no-conf or Don\'t read devscripts config files; + --noconf must be the first option given + -a Search for changes file made for Debian build + -t Search for changes file made for GNU arch + --debs-dir DIR Look for the changes and debs files in DIR instead of + the parent of the current package directory + --list-changes only list the .changes file + --list-debs only list the .deb files; don't display their contents + --multi Search for multiarch .changes file made by dpkg-cross + --check-dirname-level N + How much to check directory names: + N=0 never + N=1 only if program changes directory (default) + N=2 always + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE\' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + --help Show this message + --version Show version and copyright information + +Default settings modified by devscripts configuration files: +$modified_conf_msg +EOF +} + +if ($progname eq 'debi') { *usage = \&usage_i; } +elsif ($progname eq 'debc') { *usage = \&usage_c; } +else { die "Unrecognised invocation name: $progname\n"; } + +my $version = <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999-2003, Julian Gilbey , +all rights reserved. +Based on original code by Christoph Lameter and James R. Van Zandt. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of +the GNU General Public License, version 2 or later. +EOF + +# Start by setting default values +my $debsdir; +my $debsdir_warning; +my $check_dirname_level = 1; +my $check_dirname_regex = 'PACKAGE(-.+)?'; +my $install_tool = (-t STDOUT ? 'apt' : 'apt-get'); + +# Next, read configuration files and then command line +# The next stuff is boilerplate + +if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { + $modified_conf_msg = " (no configuration files read)"; + shift; +} else { + my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); + my %config_vars = ( + 'DEBRELEASE_DEBS_DIR' => '..', + 'DEVSCRIPTS_CHECK_DIRNAME_LEVEL' => 1, + 'DEVSCRIPTS_CHECK_DIRNAME_REGEX' => 'PACKAGE(-.+)?', + ); + my %config_default = %config_vars; + + my $shell_cmd; + # Set defaults + foreach my $var (keys %config_vars) { + $shell_cmd .= qq[$var="$config_vars{$var}";\n]; + } + $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; + $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; + # Read back values + foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } + my $shell_out = `/bin/bash -c '$shell_cmd'`; + @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; + + # Check validity + $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} =~ /^[012]$/ + or $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} = 1; + # We do not replace this with a default directory to avoid accidentally + # installing a broken package + $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%/+%/%; + $config_vars{'DEBRELEASE_DEBS_DIR'} =~ s%(.)/$%$1%; + $debsdir_warning + = "config file specified DEBRELEASE_DEBS_DIR directory $config_vars{'DEBRELEASE_DEBS_DIR'} does not exist!"; + + foreach my $var (sort keys %config_vars) { + if ($config_vars{$var} ne $config_default{$var}) { + $modified_conf_msg .= " $var=$config_vars{$var}\n"; + } + } + $modified_conf_msg ||= " (none)\n"; + chomp $modified_conf_msg; + + $debsdir = $config_vars{'DEBRELEASE_DEBS_DIR'}; + $check_dirname_level = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'}; + $check_dirname_regex = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_REGEX'}; +} + +# Command line options next +my ($opt_help, $opt_version, $opt_a, $opt_t, $opt_debsdir, $opt_multi); +my $opt_upgrade; +my ($opt_level, $opt_regex, $opt_noconf); +my ($opt_tool, $opt_with_depends); +my ($opt_list_changes, $opt_list_debs); +GetOptions( + "help" => \$opt_help, + "version" => \$opt_version, + "a=s" => \$opt_a, + "t=s" => \$opt_t, + "debs-dir=s" => \$opt_debsdir, + "m|multi" => \$opt_multi, + "u|upgrade" => \$opt_upgrade, + "check-dirname-level=s" => \$opt_level, + "check-dirname-regex=s" => \$opt_regex, + "with-depends" => \$opt_with_depends, + "tool=s" => \$opt_tool, + "noconf" => \$opt_noconf, + "no-conf" => \$opt_noconf, + "list-changes" => \$opt_list_changes, + "list-debs" => \$opt_list_debs, + ) + or die +"Usage: $progname [options] [.changes file] [package ...]\nRun $progname --help for more details\n"; + +if ($opt_help) { usage(); exit 0; } +if ($opt_version) { print $version; exit 0; } +if ($opt_noconf) { + die +"$progname: --no-conf is only acceptable as the first command-line option!\n"; +} + +my ($targetarch, $targetgnusystem); +$targetarch = $opt_a ? "-a$opt_a" : ""; +$targetgnusystem = $opt_t ? "-t$opt_t" : ""; + +if (defined $opt_level) { + if ($opt_level =~ /^[012]$/) { $check_dirname_level = $opt_level; } + else { + die +"$progname: unrecognised --check-dirname-level value (allowed are 0,1,2)\n"; + } +} + +if (defined $opt_regex) { $check_dirname_regex = $opt_regex; } + +if ($opt_tool) { + $install_tool = $opt_tool; +} + +# Is a .changes file listed on the command line? +my ($changes, $mchanges, $arch); +if (@ARGV and $ARGV[0] =~ /\.changes$/) { + $changes = shift; +} + +# Need to determine $arch in any event +$arch = `dpkg-architecture $targetarch $targetgnusystem -qDEB_HOST_ARCH`; +if ($? != 0 or !$arch) { + die "$progname: unable to determine target architecture.\n"; +} +chomp $arch; + +my @foreign_architectures; +unless ($opt_a || $opt_t || $progname eq 'debc') { + @foreign_architectures + = map { chomp; $_ } `dpkg --print-foreign-architectures`; +} + +my $chdir = 0; + +if (!defined $changes) { + if ($opt_debsdir) { + $opt_debsdir =~ s%/+%/%; + $opt_debsdir =~ s%(.)/$%$1%; + $debsdir_warning = "--debs-dir directory $opt_debsdir does not exist!"; + $debsdir = $opt_debsdir; + } + + if (!-d $debsdir) { + die "$progname: $debsdir_warning\n"; + } + + # Look for .changes file via debian/changelog + until (-r 'debian/changelog') { + $chdir = 1; + chdir '..' or die "$progname: can't chdir ..: $!\n"; + if (cwd() eq '/') { + die +"$progname: cannot find readable debian/changelog anywhere!\nAre you in the source code tree?\n"; + } + } + + if (-e ".svn/deb-layout") { + # Cope with format of svn-buildpackage tree + my $fh; + open($fh, "<", ".svn/deb-layout") + || die "Can't open .svn/deb-layout: $!\n"; + my ($build_area) = grep /^buildArea=/, <$fh>; + close($fh); + if (defined($build_area) and not $opt_debsdir) { + chomp($build_area); + $build_area =~ s/^buildArea=//; + $debsdir = $build_area if -d $build_area; + } + } + + # Find the source package name and version number + my $changelog = changelog_parse(); + + die "$progname: no package name in changelog!\n" + unless exists $changelog->{'Source'}; + die "$progname: no package version in changelog!\n" + unless exists $changelog->{'Version'}; + + # Is the directory name acceptable? + if ($check_dirname_level == 2 + or ($check_dirname_level == 1 and $chdir)) { + my $re = $check_dirname_regex; + $re =~ s/PACKAGE/\\Q$changelog->{'Source'}\\E/g; + my $gooddir; + if ($re =~ m%/%) { $gooddir = eval "cwd() =~ /^$re\$/;"; } + else { $gooddir = eval "basename(cwd()) =~ /^$re\$/;"; } + + if (!$gooddir) { + my $pwd = cwd(); + die <<"EOF"; +$progname: found debian/changelog for package $changelog->{'Source'} in the directory + $pwd +but this directory name does not match the package name according to the +regex $check_dirname_regex. + +To run $progname on this package, see the --check-dirname-level and +--check-dirname-regex options; run $progname --help for more info. +EOF + } + } + + my $sversion = $changelog->{'Version'}; + $sversion =~ s/^\d+://; + my $package = $changelog->{'Source'}; + my $pva = "${package}_${sversion}_${arch}"; + $changes = "$debsdir/$pva.changes"; + + if (!-e $changes and -d "../build-area") { + # Try out default svn-buildpackage structure in case + # we were going to fail anyway... + $changes = "../build-area/$pva.changes"; + } + + if ($opt_multi) { + my @mchanges = glob("$debsdir/${package}_${sversion}_*+*.changes"); + @mchanges = grep { /[_+]$arch[\.+]/ } @mchanges; + $mchanges = $mchanges[0] || ''; + $mchanges ||= "$debsdir/${package}_${sversion}_multi.changes" + if -f "$debsdir/${package}_${sversion}_multi.changes"; + } +} + +if ($opt_list_changes) { + printf "%s\n", $changes; + exit(0); +} + +chdir dirname($changes) + or die "$progname: can't chdir to $changes directory: $!\n"; +$changes = basename($changes); +$mchanges = basename($mchanges) if $opt_multi; + +if (!-r $changes or $opt_multi and $mchanges and !-r $mchanges) { + die "$progname: can't read $changes" + . (($opt_multi and $mchanges) ? " or $mchanges" : "") . "!\n"; +} + +if (!-r $changes and $opt_multi) { + $changes = $mchanges; +} else { + $opt_multi = 0; +} +# $opt_multi now tells us whether we're actually using a multi-arch .changes +# file + +my @debs = (); +my %pkgs = map { $_ => 0 } @ARGV; +my $ctrl = Dpkg::Control->new(name => $changes, type => CTRL_FILE_CHANGES); +$ctrl->load($changes); +for (split(/\n/, $ctrl->{Files})) { + # udebs are only supported for debc + if ( (($progname eq 'debi') && (/ (\S*\.deb)$/)) + || (($progname eq 'debc') && (/ (\S*\.u?deb)$/))) { + my $deb = $1; + open(my $stdout, '-|', 'dpkg-deb', '-f', $deb); + my $fields = Dpkg::Control->new(name => $deb, type => CTRL_PKG_DEB); + $fields->parse($stdout, $deb); + my $pkg = $fields->{Package}; + + # don't want to install other archs' .debs, unless they are + # Multi-Arch: same: + next + unless ( + $progname eq 'debc' + || $fields->{Architecture} eq 'all' + || $fields->{Architecture} eq $arch + || (($fields->{'Multi-Arch'} || 'no') eq 'same' + && grep { $_ eq $fields->{Architecture} } + @foreign_architectures)); + + if (@ARGV) { + if (exists $pkgs{$pkg}) { + push @debs, $deb; + $pkgs{$pkg}++; + } elsif (exists $pkgs{$deb}) { + push @debs, $deb; + $pkgs{$deb}++; + } + } else { + push @debs, $deb; + } + } +} + +if (!@debs) { + die + "$progname: no appropriate .debs found in the changes file $changes!\n"; +} + +if ($progname eq 'debi') { + my @upgrade = $opt_upgrade ? ('-O') : (); + if ($opt_with_depends) { + if ($install_tool =~ /^apt(?:-get)?$/ && !$opt_upgrade) { + spawn( + exec => + [$install_tool, 'install', '--reinstall', "./$changes"], + wait_child => 1 + ); + } else { + my @apt_opts; + + if ($install_tool =~ /^apt(?:-get)?$/) { + push @apt_opts, '--with-source', "./$changes"; + } + + spawn( + exec => ['debpkg', @upgrade, '--unpack', @debs], + wait_child => 1 + ); + spawn( + exec => [$install_tool, @apt_opts, '-f', 'install'], + wait_child => 1 + ); + } + } else { + if ($install_tool =~ /^apt(?:-get)?$/ && $opt_upgrade) { + spawn( + exec => [ + $install_tool, 'install', + '--only-upgrade', '--reinstall', + "./$changes" + ], + wait_child => 1 + ); + } else { + spawn(exec => ['debpkg', @upgrade, '-i', @debs], wait_child => 1); + } + } +} else { + # $progname eq 'debc' + foreach my $deb (@debs) { + if ($opt_list_debs) { + printf "%s/%s\n", cwd(), $deb; + next; + } + print "$deb\n"; + print '-' x length($deb), "\n"; + system('dpkg-deb', '-I', $deb) == 0 + or die "$progname: dpkg-deb -I $deb failed\n"; + system('dpkg-deb', '-c', $deb) == 0 + or die "$progname: dpkg-deb -c $deb failed\n"; + print "\n"; + } +} + +# Now do a sanity check +if (@ARGV) { + foreach my $pkg (keys %pkgs) { + if ($pkgs{$pkg} == 0) { + warn "$progname: package $pkg not found in $changes, ignoring\n"; + } elsif ($pkgs{$pkg} > 1) { + warn +"$progname: package $pkg found more than once in $changes, installing all\n"; + } + } +} + +exit 0; diff --git a/scripts/debpkg-wrapper.c b/scripts/debpkg-wrapper.c new file mode 100644 index 0000000..4a4d48f --- /dev/null +++ b/scripts/debpkg-wrapper.c @@ -0,0 +1,17 @@ +/* Wrapper for debpkg so that we don't have to use suidperl any longer + (it's deprecated as of Perl 5.8.0) */ + +#include +#include +#include +#include + +#define REAL_PATH "/usr/share/devscripts/debpkg" + +int main(int ac, char **av) +{ + execv(REAL_PATH, av); + + fprintf(stderr, "Error executing debpkg: %s\n", strerror(errno)); + return 1; +} diff --git a/scripts/debpkg.1 b/scripts/debpkg.1 new file mode 100644 index 0000000..77df022 --- /dev/null +++ b/scripts/debpkg.1 @@ -0,0 +1,25 @@ +.TH DEBPKG 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debpkg \- wrapper for dpkg +.SH SYNOPSIS +\fBdebpkg\fP \fIdpkg-options\fP +.SH DESCRIPTION +\fBdebpkg\fR simply invokes \fBdpkg\fP(1) but first becomes superuser +so that \fBdpkg\fP is able to install and remove packages. It also +cleans the environment and resets PATH to a sane default: +"/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11" so that local versions of +programs are not run by accident. +.SH REQUIREMENTS +\fBdebpkg\fP must be given superuser privileges in some way to +function properly. \fBAccess to debpkg with those privileges is the +same as having superuser access to your machine.\fP \fBdebpkg\fP will +abort if it finds that it neither being run by root nor setuid root. +.PP +The \fBdevscripts\fR package has been designed to allow \fBdebpkg\fR +to be made setuid root. This works by using a compiled wrapper +script, which means that \fBsuidperl\fR is not required. See +\fBdpkg-statoverride\fR(8) if you wish to make this program setuid +root. \fBsudo\fR or \fBsuper\fR could also conceivably be used. +.SH AUTHOR +Christoph Lameter ; minor modifications made by +Julian Gilbey . diff --git a/scripts/debpkg.pl b/scripts/debpkg.pl new file mode 100755 index 0000000..4d8be83 --- /dev/null +++ b/scripts/debpkg.pl @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +# Perl version of Christoph Lameter's debpkg program. +# Written by Julian Gilbey, December 1998. + +# Copyright 1999, Julian Gilbey +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +# All this program does is to check that it is either running as root +# or setuid root, and then exec dpkg with the command line options. + +# As this may be running setuid, we make sure to clean out the +# environment before we go further. Also wise for building the +# packages, anyway. We don't put /usr/local/bin in the PATH as Debian +# programs will presumably be built without the use of any locally +# installed programs. This could be changed, but in which case, +# you probably want to add /usr/local/bin at the END so that you don't +# get any unexpected behaviour. + +use 5.003; +use strict; +use warnings; +use File::Basename; + +my $progname = basename($0); + +# Predeclare functions +sub fatal($); + +my $usage = "Usage: $progname --help|--version|dpkg-options\n"; + +my $version = <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999 by Julian Gilbey, all rights reserved. +Based on code by Christoph Lameter. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. +EOF + +## +## handle command-line options +## +if (!@ARGV) { print STDERR $usage; exit 1; } +if ($ARGV[0] eq '--help') { print $usage; exit 0; } +if ($ARGV[0] eq '--version') { print $version; exit 0; } + +# We *do* preserve locale variables; dpkg should know how to handle +# them, and anyone running this with root privileges has total power +# over the system anyway, so doesn't really need to worry about forging +# locale data. We don't try to preserve TEXTDOMAIN and the like. +foreach my $var (keys %ENV) { + delete $ENV{$var} + unless $var =~ /^(PATH|TERM|HOME|LOGNAME|LANG)$/ + or $var =~ /^LC_[A-Z]+$/; +} + +$ENV{'PATH'} = "/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11"; +# $ENV{'PATH'} = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11"; +$ENV{'TERM'} = 'dumb' unless defined $ENV{'TERM'}; + +# Pick up superuser privileges if we are running setuid root +if ($< != 0 && $> == 0) { $< = $>; } +fatal "debpkg is only useful if it is run by root or setuid root!" + if $< != 0; + +# Pick up group 'root' +$( = $) = 0; + +# @ARGV is tainted, so we need to untaint it. Don't bother doing any +# checking; anyone running this as root can do anything anyway. +my @clean_argv = map { /^(.*)$/ && $1; } @ARGV; +exec 'dpkg', @clean_argv or fatal "Couldn't exec dpkg: $!\n"; + +###### Subroutines + +sub fatal($) { + my ($pack, $file, $line); + ($pack, $file, $line) = caller(); + (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d; + $msg =~ s/\n\n$/\n/; + die $msg; +} diff --git a/scripts/debrebuild.pl b/scripts/debrebuild.pl new file mode 100755 index 0000000..1f0446e --- /dev/null +++ b/scripts/debrebuild.pl @@ -0,0 +1,1280 @@ +#!/usr/bin/perl +# +# Copyright © 2014-2020 Johannes Schauer Marin Rodrigues +# Copyright © 2020 Niels Thykier +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. + +use strict; +use warnings; +use autodie; + +use Getopt::Long qw(:config gnu_getopt no_bundling no_auto_abbrev); + +use Dpkg::Control; +use Dpkg::Index; +use Dpkg::Deps; +use Dpkg::Source::Package; +use File::Temp qw(tempdir); +use File::Path qw(make_path); +use File::HomeDir; +use JSON::PP; +use Time::Piece; +use File::Basename; +use List::Util qw(any none); + +my $progname; + +BEGIN { + $progname = basename($0); + eval { require String::ShellQuote; }; + if ($@) { + if ($@ =~ /^Can\'t locate String\/ShellQuote\.pm/) { + die +"$progname: you must have the libstring-shellquote-perl package installed\n" + . "to use this script"; + } else { + die +"$progname: problem loading the String::ShellQuote module:\n $@\n" + . "Have you installed the libstring-shellquote-perl package?"; + } + } + + eval { + require LWP::Simple; + require LWP::UserAgent; + require URI::Escape; # libwww-perl depends on liburi-perl + no warnings; + $LWP::Simple::ua + = LWP::UserAgent->new(agent => 'LWP::UserAgent/debrebuild'); + $LWP::Simple::ua->env_proxy(); + }; + if ($@) { + if ($@ =~ m/Can\'t locate LWP/) { + die "$progname: you must have the libwww-perl package installed\n" + . "to use this script"; + } else { + die "$progname: problem loading the LWP and URI modules:\n $@\n" + . "Have you installed the libwww-perl package?"; + } + } + +} + +my $respect_build_path = 1; +my $use_tor = 0; +my $outdir = './'; +my $builder = 'none'; +my $timestamp = ''; + +my %OPTIONS = ( + 'help|h' => sub { usage(0); }, + 'use-tor-proxy!' => \$use_tor, + 'respect-build-path!' => \$respect_build_path, + 'buildresult=s' => \$outdir, + 'builder=s' => \$builder, + 'timestamp|t=s' => \$timestamp, +); + +sub usage { + my ($exit_code) = @_; + $exit_code //= 0; + print < + $progname <--help|-h> + +Given a buildinfo file from a Debian package, generate instructions for +attempting to reproduce the binary packages built from the associated source +and build information. + +Options: + --help, -h Show this help and exit + --[no-]use-tor-proxy Whether to fetch resources via tor (socks://127.0.0.1:9050) + Assumes "apt-transport-tor" is installed both in host + chroot + --[no-]respect-build-path Whether to setup the build to use the Build-Path from the + provided .buildinfo file. + --buildresults Directory for the build artifacts (default: ./) + --builder=BUILDER Which building software should be used. Possible values are + none, sbuild, mmdebstrap, dpkg and sbuild+unshare. The default + is none. See section BUILDER for details. + --timestamp, -t The required unstable main timestamps from snapshot.d.o if you + already know them, separated by commas, or one of the values + "first_seen" or "metasnap". See section TIMESTAMPS. + +Note: $progname can parse buildinfo files with and without a GPG signature. However, +the signature (if present) is discarded as debrebuild does not support verifying +it. If the authenticity or integrity of the buildinfo files are important to +you, checking these need to be done before invoking $progname, for example by using +dscverify. + +EXAMPLES + + \$ $progname --buildresults=./artifacts --builder=mmdebstrap hello_2.10-2_amd64.buildinfo + +BUILDERS + +debrebuild can use different backends to perform the actual package rebuild. +The desired backend is chosen using the --builder option. The default is +"none". + + none Dry-run mode. No build is performed. + sbuild Use sbuild to build the package. This requires sbuild to be + setup with schroot chroots of Debian stable distributions. + mmdebstrap Use mmdebstrap to build the package. This requires no + setup and no superuser privileges. + dpkg Directly run apt-get and dpkg-buildpackage on the current + system without chroot. This requires root privileges. + sbuild+unshare Use sbuild with the unshare backend. This will create the + chroot and perform the build without superuser privileges + and without any setup. + +TIMESTAMPS + +The --timestamp option allows one to skip the step of figuring out the correct +set of required timestamps by listing them separated by commas in the same +format used in the snapshot.d.o URL. The default is to use the "first_seen" +attribute from the snapshot.d.o API and download multiple Packages files until +all required timestamps are found. To explicitly select this mode, use +--timestamp=first_seen. Lastly, the metasnap.d.n service can be used to figure +out the right set of timestamps. This mode can be selected by using +--timestamp=metasnap. In contrast to the "first_seen" mode, the metasnap.d.n +service will always return a minimal set of timestamps if the package versions +were at some point part of Debian unstable main. + +UNSHARE + +Before kernel 5.10.1 or before Debian 11 (Bullseye), unprivileged user +namespaces were disabled in Debian for security reasons. Refer to Debian bug +#898446 for details. To enable user namespaces, run: + + \$ sudo sysctl -w kernel.unprivileged_userns_clone=1 + +The sbuild+unshare builder requires and the mmdebstrap builder benefits from +having unprivileged user namespaces activated. On Ubuntu they are enabled by +default. + +LIMITATIONS + +Currently, the code assumes that all packages were at some point part of Debian +unstable main. This fails for packages from Debian ports, packages from +experimental as well as for locally built packages or packages from third +party repositories. Enabling support for Debian ports and experimental is +conceptually possible and only needs somebody implementing it. + +EOF + + exit($exit_code); +} + +GetOptions(%OPTIONS); + +my $buildinfo = shift @ARGV; +if (not defined($buildinfo)) { + print STDERR "ERROR: Missing mandatory buildinfo filename\n"; + print STDERR "\n"; + usage(1); +} +if ($buildinfo eq '--help' or $buildinfo eq '-h') { + usage(0); +} + +if ($buildinfo =~ m/^-/) { + print STDERR "ERROR: Unsupported option $buildinfo\n"; + print STDERR "\n"; + usage(1); +} + +if (@ARGV) { + print STDERR "ERROR: This program requires exactly argument!\n"; + print STDERR "\n"; + usage(1); +} + +my $base_mirror = "http://snapshot.debian.org/archive/debian"; +if ($use_tor) { + $base_mirror = "tor+http://snapshot.debian.org/archive/debian"; + eval { + $LWP::Simple::ua->proxy([qw(http https)] => 'socks://127.0.0.1:9050'); + }; + if ($@) { + if ($@ =~ m/Can\'t locate LWP/) { + die +"Unable to use tor: the liblwp-protocol-socks-perl package is not installed\n"; + } else { + die "Unable to use tor: Couldn't load socks proxy support: $@\n"; + } + } +} + +# buildinfo support in libdpkg-perl (>= 1.18.11) +my $cdata = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1); + +if (not $cdata->load($buildinfo)) { + die "cannot load $buildinfo\n"; +} + +if ($cdata->get_option('is_pgp_signed')) { + print +"$buildinfo contained a GPG signature; it has NOT been validated (debrebuild does not support this)!\n"; +} else { + print "$buildinfo was unsigned\n"; +} + +my @architectures = split /\s+/, $cdata->{"Architecture"}; +my $build_source = (scalar(grep /^source$/, @architectures)) == 1; +my $build_archall = (scalar(grep /^all$/, @architectures)) == 1; +@architectures = grep { !/^source$/ && !/^all$/ } @architectures; +if (scalar @architectures > 1) { + die "more than one architecture in Architecture field\n"; +} +my $build_archany = (scalar @architectures) == 1; + +my $build_arch = $cdata->{"Build-Architecture"}; +if (not defined($build_arch)) { + die "need Build-Architecture field\n"; +} +my $host_arch = $cdata->{"Host-Architecture"}; +if (not defined($host_arch)) { + $host_arch = $build_arch; +} + +my $srcpkgname = $cdata->{Source}; +my $srcpkgver = $cdata->{Version}; +my $srcpkgbinver + = $cdata->{Version}; # this version will include the binmu suffix +if ($srcpkgname =~ / /) { + # In some cases such as binNMUs, the source field contains a version in + # the form: + # mscgen (0.20) + ($srcpkgname, $srcpkgver) = split / /, $srcpkgname, 2; + # Add a simple control check to avoid the worst surprises and stop obvious + # cases of garbage-in-garbage-out. + die("Unexpected source package name: ${srcpkgname}\n") + if $srcpkgname =~ m{[ \t_/\(\)<>!\n%&\$\#\@]}; + # remove the surrounding parenthesis from the version + $srcpkgver =~ s/^\((.*)\)$/$1/; +} + +my $new_buildinfo; +{ + my $arch; + if ($build_archany) { + $arch = $host_arch; + } elsif ($build_archall) { + $arch = 'all'; + } else { + die "nothing to build\n"; + } + $new_buildinfo = "$outdir/${srcpkgname}_${srcpkgbinver}_$arch.buildinfo"; +} +if (-e $new_buildinfo) { + my ($dev1, $ino1) = (lstat $buildinfo)[0, 1] + or die "cannot lstat $buildinfo: $!\n"; + my ($dev2, $ino2) = (lstat $new_buildinfo)[0, 1] + or die "cannot lstat $new_buildinfo: $!\n"; + if ($dev1 == $dev2 && $ino1 == $ino2) { + die "refusing to overwrite the input buildinfo file\n"; + } +} + +my $inst_build_deps = $cdata->{"Installed-Build-Depends"}; +if (not defined($inst_build_deps)) { + die "need Installed-Build-Depends field\n"; +} +my $custom_build_path = $respect_build_path ? $cdata->{'Build-Path'} : undef; + +if (defined($custom_build_path)) { + if ($custom_build_path =~ m{['`\$\\"\(\)<>#]|(?:\a|/)[.][.](?:\z|/)}) { + warn( +"Retry build with --no-respect-build-path to ignore the Build-Path field.\n" + ); + die( +"Refusing to use $custom_build_path as Build-Path: Looks too special to be true" + ); + } + + if ($custom_build_path eq '' or $custom_build_path !~ m{^/}) { + warn( +"Retry build with --no-respect-build-path to ignore the Build-Path field.\n" + ); + die( +qq{Build-Path must be a non-empty absolute path (i.e. start with "/").\n} + ); + } + print "Using defined Build-Path: ${custom_build_path}\n"; +} else { + if ($respect_build_path) { + print +"No Build-Path defined; not setting a defined build path for this build.\n"; + } +} + +my $srcpkg = Dpkg::Source::Package->new(); +$srcpkg->{fields}{'Source'} = $srcpkgname; +$srcpkg->{fields}{'Version'} = $srcpkgver; +my $dsc_fname + = (dirname($buildinfo)) . '/' . $srcpkg->get_basename(1) . ".dsc"; + +my $environment = $cdata->{"Environment"}; +if (not defined($environment)) { + die "need Environment field\n"; +} +$environment =~ s/\n/ /g; # remove newlines +$environment =~ s/^ //; # remove leading whitespace + +my @environment; +foreach my $line (split /\n/, $cdata->{"Environment"}) { + chomp $line; + if ($line eq '') { + next; + } + my ($name, $val) = split /=/, $line, 2; + $val =~ s/^"(.*)"$/$1/; + push @environment, "$name=$val"; +} + +# gather all installed build-depends and figure out the version of base-files +my $base_files_version; +my @inst_build_deps = (); +$inst_build_deps + = deps_parse($inst_build_deps, reduce_arch => 0, build_dep => 0); +if (!defined $inst_build_deps) { + die "deps_parse failed\n"; +} + +foreach my $pkg ($inst_build_deps->get_deps()) { + if (!$pkg->isa('Dpkg::Deps::Simple')) { + die "dependency disjunctions are not allowed\n"; + } + if (not defined($pkg->{package})) { + die "name undefined\n"; + } + if (defined($pkg->{relation})) { + if ($pkg->{relation} ne "=") { + die "wrong relation"; + } + if (not defined($pkg->{version})) { + die "version undefined\n"; + } + } else { + die "no version"; + } + if ($pkg->{package} eq "base-files") { + if (defined($base_files_version)) { + die "more than one base-files\n"; + } + $base_files_version = $pkg->{version}; + } + push @inst_build_deps, + { + name => $pkg->{package}, + architecture => $pkg->{archqual}, + version => $pkg->{version} }; +} + +if (!defined($base_files_version)) { + die "no base-files\n"; +} + +# figure out the debian release from the version of base-files +my $base_dist; + +my %base_files_map = (); +my $di_path = '/usr/share/distro-info/debian.csv'; +eval { require Debian::DistroInfo; }; +if (!$@) { + # libdistro-info-perl is installed + my $di = DebianDistroInfo->new(); + foreach my $series ($di->all) { + if (!$di->version($series)) { + next; + } + $base_files_map{ $di->version($series) } = $series; + } +} elsif (-f $di_path) { + # distro-info-data is installed + open my $fh, '<', $di_path or die "cannot open $di_path: $!\n"; + my $i = 0; + while (my $line = <$fh>) { + chomp($line); + $i++; + my @cells = split /,/, $line; + if (scalar @cells < 4) { + die "cannot parse line $i of $di_path\n"; + } + if ( + $i == 1 + and ( scalar @cells < 6 + or $cells[0] ne 'version' + or $cells[1] ne 'codename' + or $cells[2] ne 'series' + or $cells[3] ne 'created' + or $cells[4] ne 'release' + or $cells[5] ne 'eol') + ) { + die "cannot find correct header in $di_path\n"; + } + if ($i == 1) { + next; + } + $base_files_map{ $cells[0] } = $cells[2]; + } + close $fh; +} else { + # nothing is installed -- use hard-coded values + %base_files_map = ( + "6" => "squeeze", + "7" => "wheezy", + "8" => "jessie", + "9" => "stretch", + "10" => "buster", + "11" => "bullseye", + "12" => "bookworm", + "13" => "trixie", + ); +} + +$base_files_version =~ s/^(\d+).*/$1/; + +# we subtract one from $base_files_version because we want the Debian release +# before what is currently in unstable +$base_dist = $base_files_map{ $base_files_version - 1 }; + +if (!defined $base_dist) { + die "base-files version didn't map to any Debian release\n"; +} + +my $src_date; +{ + print "retrieving snapshot.d.o data for $srcpkgname $srcpkgver\n"; + my $json_url + = "http://snapshot.debian.org/mr/package/$srcpkgname/$srcpkgver/srcfiles?fileinfo=1"; + my $content = LWP::Simple::get($json_url); + die "cannot retrieve $json_url" unless defined $content; + my $json = JSON::PP->new(); + # json options taken from debsnap + my $json_text = $json->allow_nonref->utf8->relaxed->decode($content); + die "cannot decode json" unless defined $json_text; + foreach my $result (@{ $json_text->{result} }) { + # FIXME - assumption: package is from Debian official (and not ports) + my @package_from_main = grep { $_->{archive_name} eq "debian" } + @{ $json_text->{fileinfo}->{ $result->{hash} } }; + if (scalar @package_from_main > 1) { + die + "more than one package with the same hash in Debian official\n"; + } + if (scalar @package_from_main == 0) { + die "no package with the right hash in Debian official\n"; + } + $src_date = $package_from_main[0]->{first_seen}; + } +} +if (!defined($src_date)) { + die "cannot find .dsc\n"; +} + +# support timestamps being separated by a comma +my @required_timestamps = (); +if ($timestamp eq "first_seen") { + # nothing to do, timestamps will be figured out later +} elsif ($timestamp eq "metasnap") { + # acquire the required timestamps using metasnap.d.n + print "retrieving required timestamps from metasnap.d.n\n"; + my $ua = LWP::UserAgent->new(timeout => 10); + $ua->env_proxy; + my @pkgs = (); + foreach my $pkg (@inst_build_deps) { + my $pkg_name = $pkg->{name}; + my $pkg_ver = $pkg->{version}; + my $pkg_arch = $pkg->{architecture}; + if (defined $pkg_arch) { + push @pkgs, + URI::Escape::uri_escape("$pkg_name:$pkg_arch=$pkg_ver"); + } else { + push @pkgs, URI::Escape::uri_escape("$pkg_name=$pkg_ver"); + } + } + my $response + = $ua->get('https://metasnap.debian.net/cgi-bin/api' + . '?archive=debian' + . "&pkgs=" + . (join "%2C", @pkgs) + . "&arch=$build_arch" + . '&suite=unstable' + . '&comp=main'); + if (!$response->is_success) { + die "request to metasnap.d.n failed: $response->status_line"; + } + foreach my $line (split /\n/, $response->decoded_content) { + my ($arch, $t) = split / /, $line, 2; + if ($arch ne $build_arch) { + die +"debrebuild is currently unable to handle multiple architectures"; + } + push @required_timestamps, $t; + } +} else { + @required_timestamps = split(/,/, $timestamp); +} + +# setup a temporary apt directory + +my $tempdir = tempdir(CLEANUP => 1); + +foreach my $d (( + '/etc/apt', '/etc/apt/apt.conf.d', + '/etc/apt/preferences.d', '/etc/apt/trusted.gpg.d', + '/etc/apt/sources.list.d', '/var/lib/apt/lists/partial', + '/var/cache/apt/archives/partial', '/var/lib/dpkg', + ) +) { + make_path("$tempdir/$d"); +} + +# We use the Build-Date field as a heuristic to find a good date for the +# stable release. If we would get the stable release from deb.debian.org +# instead, then packages might be newer than in unstable of the past because +# of point releases. The date from the source package will also work in most +# cases but will fail for binNMU buildinfo files where the source package +# might even come from years in the past +my $build_date; +{ + local $ENV{LC_ALL} = 'C'; + my $tp + = Time::Piece->strptime($cdata->{'Build-Date'}, '%a, %d %b %Y %T %z'); + $build_date = $tp->strftime("%Y%m%dT%H%M%SZ"); +} + +sub get_sources_list() { + my @result = (); + push @result, "deb $base_mirror/$build_date/ $base_dist main"; + push @result, "deb-src $base_mirror/$src_date/ unstable main"; + foreach my $ts (@required_timestamps) { + push @result, "deb $base_mirror/$ts/ unstable main"; + } + return @result; +} + +open(FH, '>', "$tempdir/etc/apt/sources.list"); +print FH (join "\n", get_sources_list) . "\n"; +close FH; +# FIXME - document what's dpkg's status for +# Create dpkg status +open(FH, '>', "$tempdir/var/lib/dpkg/status"); +close FH; #empty file +# Create apt.conf +my $aptconf = "$tempdir/etc/apt/apt.conf"; +open(FH, '>', $aptconf); + +# We create an apt.conf and pass it to apt via the APT_CONFIG environment +# variable instead of passing all options via the command line because +# otherwise apt will read the system's config first and might get unwanted +# configuration options from there. See apt.conf(5) for the order in which +# configuration options are read. +# +# While we are at it, we also set all other options through our custom +# apt.conf. +# +# Apt::Architecture has to be set because otherwise apt will default to the +# architecture apt was compiled for. +# +# Apt::Architectures has to be set or otherwise apt will use dpkg to find all +# foreign architectures of the system running apt. +# +# Dir::State::status has to be set even though Dir is set because Dir::State +# is set to var/lib/apt, so Dir::State::status would be below that but really +# isn't and without an absolute path, Dir::State::status would be constructed +# from Dir + Dir::State + Dir::State::status. This has been fixed in apt +# commit 475f75506db48a7fa90711fce4ed129f6a14cc9a. +# +# Acquire::Check-Valid-Until has to be set to false because the snapshot +# timestamps might be too far in the past to still be valid. This could be +# fixed by a solution to https://bugs.debian.org/763419 +# +# Acquire::Languages has to be set to prevent downloading of translations from +# the mirrors. +# +# Binary::apt-get::Acquire::AllowInsecureRepositories has to be set to false +# so that apt-get update fails if repositories cannot be authenticated. The +# default value of this option will change to true with apt from Debian +# Buster. +# +# We need APT::Get::allow-downgrades set to true, because even if we choose a +# base distribution that was released before the state that "unstable" +# currently is in, the package versions in that stable release might be newer +# than what is in unstable due to security fixes. Choosing a stable release +# from an older snapshot timestamp would fix this problem but would defeat the +# purpose of a base distribution for builders like sbuild which can take +# advantage of existing chroot environments. + +print FH <new(); +push @keyrings, $debianvendor->run_hook('archive-keyrings'); +push @keyrings, $debianvendor->run_hook('archive-keyrings-historic'); +#my $ubuntuvendor = Dpkg::Vendor::Ubuntu->new(); +#push @keyrings, $ubuntuvendor->run_hook('archive-keyrings'); +#push @keyrings, $ubuntuvendor->run_hook('archive-keyrings-historic'); + +foreach my $keyring (@keyrings) { + my $base = basename $keyring; + print "$keyring\n"; + if (-f $keyring) { + print "linking $tempdir/etc/apt/trusted.gpg.d/$base to $keyring\n"; + symlink $keyring, "$tempdir/etc/apt/trusted.gpg.d/$base"; + } +} + +$ENV{'APT_CONFIG'} = $aptconf; + +0 == system 'apt-get', 'update' or die "apt-get update failed\n"; + +sub dpkg_index_key_func { + return + $_[0]->{Package} . ' ' + . $_[0]->{Version} . ' ' + . $_[0]->{Architecture}; +} + +sub parse_all_packages_files { + my $dpkg_index = Dpkg::Index->new(get_key_func => \&dpkg_index_key_func); + + open(my $fd, '-|', 'apt-get', 'indextargets', '--format', '$(FILENAME)', + 'Created-By: Packages'); + while (my $fname = <$fd>) { + chomp $fname; + print "parsing $fname...\n"; + open(my $fd2, '-|', '/usr/lib/apt/apt-helper', 'cat-file', $fname); + $dpkg_index->parse($fd2, "pipe") or die "cannot parse Packages file\n"; + close($fd2); + } + close($fd); + return $dpkg_index; +} + +my $index = parse_all_packages_files(); +if (scalar @required_timestamps == 0) { + # go through all packages in the Installed-Build-Depends field and find out + # the timestamps at which they were first seen each + my %notfound_timestamps; + + my %missing; + + foreach my $pkg (@inst_build_deps) { + my $pkg_name = $pkg->{name}; + my $pkg_ver = $pkg->{version}; + my $pkg_arch = $pkg->{architecture}; + + # check if we really need to acquire this package from snapshot.d.o or if + # it already exists in the cache + if (defined $pkg->{architecture}) { + if ($index->get_by_key("$pkg_name $pkg_ver $pkg_arch")) { + print "skipping $pkg_name $pkg_ver\n"; + next; + } + } else { + if ($index->get_by_key("$pkg_name $pkg_ver $build_arch")) { + $pkg->{architecture} = $build_arch; + print "skipping $pkg_name $pkg_ver\n"; + next; + } + if ($index->get_by_key("$pkg_name $pkg_ver all")) { + $pkg->{architecture} = "all"; + print "skipping $pkg_name $pkg_ver\n"; + next; + } + } + + print "retrieving snapshot.d.o data for $pkg_name $pkg_ver\n"; + my $json_url + = "http://snapshot.debian.org/mr/binary/$pkg_name/$pkg_ver/binfiles?fileinfo=1"; + my $content = LWP::Simple::get($json_url); + die "cannot retrieve $json_url" unless defined $content; + my $json = JSON::PP->new(); + # json options taken from debsnap + my $json_text = $json->allow_nonref->utf8->relaxed->decode($content); + die "cannot decode json" unless defined $json_text; + my $pkg_hash; + if (scalar @{ $json_text->{result} } == 1) { + # if there is only a single result, then the package must either be + # Architecture:all, be the build architecture or match the requested + # architecture + $pkg_hash = ${ $json_text->{result} }[0]->{hash}; + $pkg->{architecture} + = ${ $json_text->{result} }[0]->{architecture}; + # if a specific architecture was requested, it should match + if (defined $pkg_arch && $pkg_arch ne $pkg->{architecture}) { + die +"package $pkg_name was explicitly requested for $pkg_arch but only $pkg->{architecture} was found\n"; + } + # if no specific architecture was requested, it should be the build + # architecture + if ( !defined $pkg_arch + && $build_arch ne $pkg->{architecture} + && "all" ne $pkg->{architecture}) { + die +"package $pkg_name was implicitly requested for $pkg_arch but only $pkg->{architecture} was found\n"; + } + # Ensure that $pkg_arch is defined from here as we want to look it up + # later in a Packages file from snapshot.d.o if it is not in the + # current Packages file + $pkg_arch = $pkg->{architecture}; + } else { + # Since the package occurs more than once, we expect it to be of + # Architecture:any + # + # If no specific architecture was requested, look for the build + # architecture + if (!defined $pkg_arch) { + $pkg_arch = $build_arch; + } + foreach my $result (@{ $json_text->{result} }) { + if ($result->{architecture} eq $pkg_arch) { + $pkg_hash = $result->{hash}; + last; + } + } + if (!defined($pkg_hash)) { + die "cannot find package in architecture $pkg_arch\n"; + } + # we now know that this package is not architecture:all but has a + # concrete architecture + $pkg->{architecture} = $pkg_arch; + } + # FIXME - assumption: package is from Debian official (and not ports) + my @package_from_main = grep { $_->{archive_name} eq "debian" } + @{ $json_text->{fileinfo}->{$pkg_hash} }; + if (scalar @package_from_main > 1) { + die + "more than one package with the same hash in Debian official\n"; + } + if (scalar @package_from_main == 0) { + die "no package with the right hash in Debian official\n"; + } + my $date = $package_from_main[0]->{first_seen}; + $pkg->{first_seen} = $date; + $notfound_timestamps{$date} = 1; + $missing{"${pkg_name}/${pkg_ver}/${pkg_arch}"} = 1; + } + + # feed apt with timestamped snapshot.debian.org URLs until apt is able to + # find all the required package versions. We start with the most recent + # timestamp, check which packages cannot be found at that timestamp, add + # the timestamp of the most recent not-found package and continue doing + # this iteratively until all versions can be found. + + while (0 < scalar keys %notfound_timestamps) { + print "left to check: " . (scalar keys %notfound_timestamps) . "\n"; + my @timestamps = map { Time::Piece->strptime($_, '%Y%m%dT%H%M%SZ') } + (sort keys %notfound_timestamps); + my $newest = $timestamps[$#timestamps]; + $newest = $newest->strftime("%Y%m%dT%H%M%SZ"); + push @required_timestamps, $newest; + delete $notfound_timestamps{$newest}; + + my $snapshot_url = "$base_mirror/$newest/"; + + open(FH, '>>', "$tempdir/etc/apt/sources.list"); + print FH "deb ${snapshot_url} unstable main\n"; + close FH; + + 0 == system 'apt-get', 'update' or die "apt-get update failed\n"; + + my $index = parse_all_packages_files(); + foreach my $pkg (@inst_build_deps) { + my $pkg_name = $pkg->{name}; + my $pkg_ver = $pkg->{version}; + my $pkg_arch = $pkg->{architecture}; + my $first_seen = $pkg->{first_seen}; + my $cdata = $index->get_by_key("$pkg_name $pkg_ver $pkg_arch"); + if (not defined($cdata->{"Package"})) { + # Not present yet; we hope a later snapshot URL will locate it. + next; + } + delete($missing{"${pkg_name}/${pkg_ver}/${pkg_arch}"}); + if (defined $first_seen) { + # this may delete timestamps that we actually need for some other + # packages + delete $notfound_timestamps{$first_seen}; + } + } + } + + if (%missing) { + print STDERR 'Cannot locate the following packages via snapshots' + . " or the current repo/mirror\n"; + for my $key (sort(keys(%missing))) { + print STDERR " ${key}\n"; + } + exit(1); + } +} else { + # find out the actual package architecture for all installed build + # dependencies without explicit architecture qualification + foreach my $pkg (@inst_build_deps) { + my $pkg_name = $pkg->{name}; + my $pkg_ver = $pkg->{version}; + if (defined $pkg->{architecture}) { + next; + } + if ($index->get_by_key("$pkg_name $pkg_ver $build_arch")) { + $pkg->{architecture} = $build_arch; + next; + } + if ($index->get_by_key("$pkg_name $pkg_ver all")) { + $pkg->{architecture} = "all"; + next; + } + die "cannot find $pkg_name $pkg_ver in index\n"; + } +} + +# remove $tempdir manually to avoid any surprises +0 == system 'apt-get', '--option', + 'Dir::Etc::SourceList=/dev/null', '--option', + 'Dir::Etc::SourceParts=/dev/null', 'update' + or die "apt-get update failed\n"; + +foreach my $f ( + '/var/cache/apt/pkgcache.bin', + '/var/cache/apt/srcpkgcache.bin', + '/var/lib/dpkg/status', + '/var/lib/apt/lists/lock', + '/etc/apt/apt.conf', + '/etc/apt/sources.list', + '/etc/apt/trusted.gpg.d/debian-archive-removed-keys.gpg', + '/etc/apt/trusted.gpg.d/debian-archive-keyring.gpg' +) { + unlink "$tempdir/$f" or die "cannot unlink $tempdir/$f: $!\n"; +} + +foreach my $d ( + '/var/cache/apt/archives/partial', '/var/cache/apt/archives', + '/var/cache/apt', '/var/cache', + '/var/lib/dpkg', '/var/lib/apt/lists/auxfiles', + '/var/lib/apt/lists/partial', '/var/lib/apt/lists', + '/var/lib/apt', '/var/lib', + '/var', '/etc/apt/sources.list.d', + '/etc/apt/trusted.gpg.d', '/etc/apt/preferences.d', + '/etc/apt/apt.conf.d', '/etc/apt', + '/etc', '' +) { + rmdir "$tempdir/$d" or die "cannot rmdir $d: $!\n"; +} + +!-e $tempdir or die "failed to remove $tempdir\n"; + +if ($builder ne "none") { + if (!-e $outdir) { + make_path($outdir); + } +} + +my $build = ''; +my $changesarch = ''; +if ($build_archany and $build_archall) { + $build = "binary"; + $changesarch = $host_arch; +} elsif ($build_archany and !$build_archall) { + $build = "any"; + $changesarch = $host_arch; +} elsif (!$build_archany and $build_archall) { + $build = "all"; + $changesarch = 'all'; +} else { + die "nothing to build\n"; +} + +my @install = (); +foreach my $pkg (@inst_build_deps) { + my $pkg_name = $pkg->{name}; + my $pkg_ver = $pkg->{version}; + my $pkg_arch = $pkg->{architecture}; + if (any { $_ eq $builder } ('mmdebstrap', 'none', 'dpkg')) { + if ($pkg_arch eq "all" || $pkg_arch eq $build_arch) { + push @install, "$pkg_name=$pkg_ver"; + } else { + push @install, "$pkg_name:$pkg_arch=$pkg_ver"; + } + } elsif (any { $_ eq $builder } ('sbuild', 'sbuild+unshare')) { + if ($pkg_arch eq "all" || $pkg_arch eq $build_arch) { + push @install, "$pkg_name (= $pkg_ver)"; + } else { + push @install, "$pkg_name:$pkg_arch (= $pkg_ver)"; + } + } else { + die "unsupported builder: $builder\n"; + } +} + +if ($builder eq "none") { + print "\n"; + print "Manual installation and build\n"; + print "-----------------------------\n"; + print "\n"; + print + "The following sources.list contains all the required repositories:\n"; + print "\n"; + print(join "\n", get_sources_list); + print "\n"; + print "You can manually install the right dependencies like this:\n"; + print "\n"; + print "apt-get install --no-install-recommends"; + + # Release files from snapshots.d.o have often expired by the time + # we fetch them. Include the option to work around that to assist + # the user. + print " -oAcquire::Check-Valid-Until=false"; + foreach my $pkg (@install) { + print " $pkg"; + } + print "\n"; + print "\n"; + print "And then build your package:\n"; + print "\n"; + if ($custom_build_path) { + require Cwd; + my $custom_build_parent_dir = dirname($custom_build_path); + my $dsc_path = Cwd::realpath($dsc_fname) + // die("Cannot resolve ${dsc_fname}: $!\n"); + print "mkdir -p \"${custom_build_parent_dir}\"\n"; + print qq{dpkg-source -x "${dsc_path}" "${custom_build_path}"\n}; + print "cd \"$custom_build_path\"\n"; + } else { + print qq{dpkg-source -x "${dsc_fname}"\n}; + print "cd packagedirectory\n"; + } + print "\n"; + if ($cdata->{"Binary-Only-Changes"}) { + print( "Since this is a binNMU, you must put the following " + . "lines at the top of debian/changelog:\n\n"); + print($cdata->{"Binary-Only-Changes"}); + } + print "\n"; + print( "$environment dpkg-buildpackage -uc " + . "--host-arch=$host_arch --build=$build\n"); +} elsif ($builder eq "dpkg") { + if ("$build_arch\n" ne `dpkg --print-architecture`) { + die "must be run on $build_arch\n"; + } + + if ($> != 0) { + die "you must be root for the dpkg builder\n"; + } + + if (-e $custom_build_path) { + die "$custom_build_path exists -- refusing to overwrite\n"; + } + + my $sources = '/etc/apt/sources.list.d/debrebuild.list'; + if (-e $sources) { + die "$sources already exists -- refusing to overwrite\n"; + } + open(FH, '>', $sources) or die "cannot open $sources: $!\n"; + print FH (join "\n", get_sources_list) . "\n"; + close FH; + + my $config = '/etc/apt/apt.conf.d/23-debrebuild.conf'; + if (-e $config) { + die "$config already exists -- refusing to overwrite\n"; + } + open(FH, '>', $config) or die "cannot open $config: $!\n"; + foreach my $line (@common_aptopts) { + print FH "$line\n"; + } + close FH; + + 0 == system 'apt-get', 'update' or die "apt-get update failed\n"; + + my @cmd + = ('apt-get', 'install', '--no-install-recommends', '--yes', @install); + 0 == system @cmd or die "apt-get install failed\n"; + + 0 == system 'apt-get', 'source', '--only-source', '--download-only', + "$srcpkgname=$srcpkgver" + or die "apt-get source failed\n"; + unlink $sources or die "failed to unlink $sources\n"; + unlink $config or die "failed to unlink $config\n"; + make_path(dirname $custom_build_path); + 0 == system 'dpkg-source', '--no-check', '--extract', + $srcpkg->get_basename(1) . '.dsc', $custom_build_path + or die "dpkg-source failed\n"; + + if ($cdata->{"Binary-Only-Changes"}) { + open my $infh, '<', "$custom_build_path/debian/changelog" + or die "cannot open debian/changelog for reading: $!\n"; + my $changelogcontent = do { local $/; <$infh> }; + close $infh; + open my $outfh, '>', "$custom_build_path/debian/changelog" + or die "cannot open debian/changelog for writing: $!\n"; + my $logentry = $cdata->{"Binary-Only-Changes"}; + # due to storing the binnmu changelog entry in deb822 buildinfo, the + # first character is an unwanted newline + $logentry =~ s/^\n//; + print $outfh $logentry; + # while the linebreak at the beginning is wrong, there are two missing + # at the end + print $outfh "\n\n"; + print $outfh $changelogcontent; + close $outfh; + } + 0 == system 'env', "--chdir=$custom_build_path", @environment, + 'dpkg-buildpackage', '-uc', "--host-arch=$host_arch", "--build=$build" + or die "dpkg-buildpackage failed\n"; + # we are not interested in the unpacked source directory + 0 == system 'rm', '-r', $custom_build_path + or die "failed to remove $custom_build_path: $?"; + # but instead we want the produced artifacts + 0 == system 'dcmd', 'mv', + (dirname $custom_build_path) + . "/${srcpkgname}_${srcpkgbinver}_$changesarch.changes", $outdir + or die "dcmd failed\n"; +} elsif ($builder eq "sbuild" or $builder eq "sbuild+unshare") { + my $tarballpath = File::HomeDir->my_home + . "/.cache/sbuild/$base_dist-$build_arch.tar.gz"; + if ($builder eq "sbuild+unshare") { + if (!-e $tarballpath) { + my $chrootdir = tempdir(); + 0 == system 'sbuild-createchroot', '--chroot-mode=unshare', + '--make-sbuild-tarball', $tarballpath, + $base_dist, $chrootdir, "$base_mirror/$build_date/" + or die "sbuild-createchroot failed\n"; + !-e $chrootdir or die "$chrootdir wasn't removed\n"; + } + } + + my @cmd = ('env', "--chdir=$outdir", @environment, 'sbuild'); + foreach my $line (get_sources_list) { + push @cmd, "--extra-repository=$line"; + } + + # Release files from snapshots.d.o have often expired by the time + # we fetch them. Include the option to work around that to assist + # the user. + push @cmd, + '--chroot-setup-commands=echo ' + . (String::ShellQuote::shell_quote(join '\n', @common_aptopts)) + . ' | tee /etc/apt/apt.conf.d/23-debrebuild.conf'; + + # sbuild chroots have build-essential already installed. This might + # interfere with the packages that we need to install. Example: + # libc6-dev : Breaks: libgcc-8-dev (< 8.4.0-2~) but 8.3.0-6 is to be inst.. + # Thus, we remove them beforehand -- the right versions will get installed + # later anyways. + # We have to list the packages manually instead of relying on autoremove + # because debootstrap marks them all as manually installed. + push @cmd, + ( '--chroot-setup-commands=apt-get --yes remove build-essential' + . ' libc6-dev gcc g++ make dpkg-dev'); + push @cmd, '--chroot-setup-commands=apt-get --yes autoremove'; + + push @cmd, "--add-depends=" . (join ",", @install); + push @cmd, "--build=$build_arch"; + push @cmd, "--host=$host_arch"; + + if ($build_source) { + push @cmd, '--source'; + } else { + push @cmd, '--no-source'; + } + if ($build_archany) { + push @cmd, '--arch-any'; + } else { + push @cmd, '--no-arch-any'; + } + if ($build_archall) { + push @cmd, '--arch-all'; + } else { + push @cmd, '--no-arch-all'; + } + if ($cdata->{"Binary-Only-Changes"}) { + push @cmd, "--binNMU-changelog=$cdata->{'Binary-Only-Changes'}"; + } + if ($builder eq "sbuild+unshare") { + push @cmd, "--chroot=$tarballpath"; + push @cmd, "--chroot-mode=unshare"; + } + push @cmd, "--dist=$base_dist"; + push @cmd, "--no-run-lintian"; + push @cmd, "--no-run-autopkgtest"; + push @cmd, "--no-apt-upgrade"; + push @cmd, "--no-apt-distupgrade"; + # disable the explainer + push @cmd, "--bd-uninstallable-explainer="; + # We need the aspcud resolver to install packages that are older than the + # ones in the latest snapshot. Apt by default will only use the latest + # package versions as candidates and sbuild uses a dummy package instead + # of crafting an apt command line with the exact version requirements. + push @cmd, "--build-dep-resolver=aspcud"; + + if ($custom_build_path) { + push @cmd, "--build-path=$custom_build_path"; + } + push @cmd, "${srcpkgname}_$srcpkgver"; + print((join " ", @cmd) . "\n"); + 0 == system @cmd or die "sbuild failed\n"; +} elsif ($builder eq "mmdebstrap") { + + my @binnmucmds = (); + if ($cdata->{"Binary-Only-Changes"}) { + my $logentry = $cdata->{"Binary-Only-Changes"}; + # due to storing the binnmu changelog entry in deb822 buildinfo, the first + # character is an unwanted newline + $logentry =~ s/^\n//; + # while the linebreak at the beginning is wrong, there are two missing at + # the end + $logentry .= "\n\n"; + push @binnmucmds, + '{ printf "%s" ' + . (String::ShellQuote::shell_quote $logentry) + . "; cat debian/changelog; } > debian/changelog.debrebuild", + "mv debian/changelog.debrebuild debian/changelog"; + } + + my @cmd = ( + 'env', '-i', + 'PATH=/usr/sbin:/usr/bin:/sbin:/bin', + 'mmdebstrap', + "--arch=$build_arch", + "--variant=apt", + (map { "--aptopt=$_" } @common_aptopts), + '--include=' . (join ' ', @install), + '--essential-hook=chroot "$1" sh -c "' + . ( + join ' && ', + 'rm /etc/apt/sources.list', + 'echo ' + . ( + String::ShellQuote::shell_quote( + (join "\n", get_sources_list) . "\n" + )) + . ' >> /etc/apt/sources.list', + 'apt-get update' + ) + . '"', + '--customize-hook=chroot "$1" sh -c "' + . ( + join ' && ', + "apt-get source --only-source -d $srcpkgname=$srcpkgver", + "mkdir -p " + . (String::ShellQuote::shell_quote(dirname $custom_build_path)), + "dpkg-source --no-check -x /" + . $srcpkg->get_basename(1) . '.dsc ' + . (String::ShellQuote::shell_quote $custom_build_path), + 'cd ' . (String::ShellQuote::shell_quote $custom_build_path), + @binnmucmds, +"env $environment dpkg-buildpackage -uc -a $host_arch --build=$build", + 'cd /', + 'rm -r ' . (String::ShellQuote::shell_quote $custom_build_path)) + . '"', + '--customize-hook=sync-out ' + . (dirname $custom_build_path) + . " $outdir", + $base_dist, + '/dev/null', + "deb $base_mirror/$build_date/ $base_dist main" + ); + print((join ' ', @cmd) . "\n"); + + 0 == system @cmd or die "mmdebstrap failed\n"; +} else { + die "unsupported builder: $builder\n"; +} + +# test if all checksums in the buildinfo file check out +if ($builder ne "none") { + print "build artifacts stored in $outdir\n"; + + my $checksums = Dpkg::Checksums->new(); + $checksums->add_from_control($cdata); + # remove the .dsc as we only did the binaries + # - the .dsc cannot be reproduced anyways because we cannot reproduce its + # signature + # - binNMUs can only be done with --build=any + foreach my $file ($checksums->get_files()) { + if ($file !~ /\.dsc$/) { + next; + } + $checksums->remove_file($file); + } + + my $new_cdata + = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1); + $new_cdata->load($new_buildinfo); + my $new_checksums = Dpkg::Checksums->new(); + $new_checksums->add_from_control($new_cdata); + + my @files = $checksums->get_files(); + my @new_files = $new_checksums->get_files(); + + if (scalar @files != scalar @new_files) { + print("old buildinfo:\n" . (join "\n", @files) . "\n"); + print("new buildinfo:\n" . (join "\n", @new_files) . "\n"); + die "new buildinfo contains a different number of files\n"; + } + + for (my $i = 0 ; $i <= $#files ; $i++) { + if ($files[$i] ne $new_files[$i]) { + die "different checksum files at position $i\n"; + } + if ($files[$i] =~ /\.dsc$/) { + print("skipping $files[$i]\n"); + next; + } + print("checking $files[$i]: "); + if ($checksums->get_size($files[$i]) + != $new_checksums->get_size($files[$i])) { + die "size differs for $files[$i]\n"; + } else { + print("size... "); + } + my $chksum = $checksums->get_checksum($files[$i], undef); + my $new_chksum = $new_checksums->get_checksum($new_files[$i], undef); + if (scalar keys %{$chksum} != scalar keys %{$new_chksum}) { + die "different algos for $files[$i]\n"; + } + foreach my $algo (keys %{$chksum}) { + if (!exists $new_chksum->{$algo}) { + die "$algo is not used in both buildinfo files\n"; + } + if ($chksum->{$algo} ne $new_chksum->{$algo}) { + die "value of $algo differs for $files[$i]\n"; + } + print("$algo... "); + } + print("all OK\n"); + } +} diff --git a/scripts/debrelease.1 b/scripts/debrelease.1 new file mode 100644 index 0000000..48d0f4a --- /dev/null +++ b/scripts/debrelease.1 @@ -0,0 +1,138 @@ +.TH DEBRELEASE 1 "Debian Utilities" "DEBIAN" \" -*- nroff -*- +.SH NAME +debrelease \- a wrapper around dupload or dput +.SH SYNOPSIS +\fBdebrelease\fR [\fIdebrelease options\fR] [\fIdupload/dput options\fR] +.SH DESCRIPTION +\fBdebrelease\fR is a simple wrapper around \fBdupload\fR or +\fBdput\fR. It is called from within the source code tree of a +package, and figures out the current version of a package. It then +looks for the corresponding \fI.changes\fR file (which lists the files +needed to upload in order to release the package) in the parent +directory of the source code tree and calls \fBdupload\fR or +\fBdput\fR with the \fI.changes\fR file as parameter in order to +perform the actual uploading. +.PP +Options may be given to \fBdebrelease\fR; except for the ones listed +below, they are passed on unchanged to \fBdupload\fR or \fBdput\fR. +The \fBdevscripts\fR configuration files are also read by +\fBdebrelease\fR as described below. +.SH "Directory name checking" +In common with several other scripts in the \fBdevscripts\fR package, +\fBdebrelease\fR will climb the directory tree until it finds a +\fIdebian/changelog\fR file. As a safeguard against stray files +causing potential problems, it will examine the name of the parent +directory once it finds the \fIdebian/changelog\fR file, and check +that the directory name corresponds to the package name. Precisely +how it does this is controlled by two configuration file variables +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR and \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR, and +their corresponding command-line options \fB\-\-check-dirname-level\fR +and \fB\-\-check-dirname-regex\fR. +.PP +\fBDEVSCRIPTS_CHECK_DIRNAME_LEVEL\fR can take the following values: +.TP +.B 0 +Never check the directory name. +.TP +.B 1 +Only check the directory name if we have had to change directory in +our search for \fIdebian/changelog\fR. This is the default behaviour. +.TP +.B 2 +Always check the directory name. +.PP +The directory name is checked by testing whether the current directory +name (as determined by \fBpwd\fR(1)) matches the regex given by the +configuration file option \fBDEVSCRIPTS_CHECK_DIRNAME_REGEX\fR or by the +command line option \fB\-\-check-dirname-regex\fR \fIregex\fR. Here +\fIregex\fR is a Perl regex (see \fBperlre\fR(3perl)), which will be +anchored at the beginning and the end. If \fIregex\fR contains a '/', +then it must match the full directory path. If not, then it must +match the full directory name. If \fIregex\fR contains the string +\'PACKAGE', this will be replaced by the source package name, as +determined from the changelog. The default value for the regex is: +\'PACKAGE(-.+)?', thus matching directory names such as PACKAGE and +PACKAGE-version. +.SH OPTIONS +.TP +\fB\-\-dupload\fR, \fB\-\-dput\fR +This specifies which uploader program to use; the default is +\fBdupload\fR. +.TP +\fB\-S\fR +If this option is used, or the default \fI.changes\fR file is +not found but a source-only \fI.changes\fR file is present, then this +source-only \fI.changes\fR file will be uploaded instead of an +arch-specific one. +.TP +\fB\-a\fIdebian-architecture\fR, \fB\-t\fIGNU-system-type\fR +See \fBdpkg-architecture\fR(1) for a description of these options. +They affect the search for the \fI.changes\fR file. They are provided +to mimic the behaviour of \fBdpkg-buildpackage\fR when determining the +name of the \fI.changes\fR file. If a plain \fB\-t\fR is given, it is +taken to be the \fBdupload\fR host-specifying option, and therefore +signifies the end of the \fBdebrelease\fR-specific options. +.TP +\fB\-\-multi\fR +Multiarch \fI.changes\fR mode: This signifies that \fBdebrelease\fR should +use the most recent file with the name pattern +\fIpackage_version_*+*.changes\fR as the \fI.changes\fR file, allowing for the +\fI.changes\fR files produced by \fBdpkg-cross\fR. +.TP +\fB\-\-debs\-dir\fR \fIdirectory\fR +Look for the \fI.changes\fR and \fI.deb\fR files in \fIdirectory\fR +instead of the parent of the source directory. This should +either be an absolute path or relative to the top of the source +directory. +.TP +\fB\-\-check-dirname-level\fR \fIN\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-check-dirname-regex\fR \fIregex\fR +See the above section \fBDirectory name checking\fR for an explanation of +this option. +.TP +\fB\-\-no-conf\fR, \fB\-\-noconf\fR +Do not read any configuration files. This can only be used as the +first option given on the command-line. +.TP +.BR \-\-help ", " \-h +Display a help message and exit successfully. +.TP +.B \-\-version +Display version and copyright information and exit successfully. +.SH "CONFIGURATION VARIABLES" +The two configuration files \fI/etc/devscripts.conf\fR and +\fI~/.devscripts\fR are sourced in that order to set configuration +variables. Command line options can be used to override configuration +file settings. Environment variable settings are ignored for this +purpose. The currently recognised variables are: +.TP +.B DEBRELEASE_UPLOADER +The currently recognised values are \fIdupload\fR and \fIdput\fR, and +it specifies which uploader program should be used. It corresponds to +the \fB\-\-dupload\fR and \fB\-\-dput\fR command line options. +.TP +.B DEBRELEASE_DEBS_DIR +This specifies the directory in which to look for the \fI.changes\fR +and \fI.deb\fR files, and is either an absolute path or relative to +the top of the source tree. This corresponds to the +\fB\-\-debs\-dir\fR command line option. This directive could be +used, for example, if you always use \fBpbuilder\fR or +\fBsvn-buildpackage\fR to build your packages. Note that it also +affects \fBdebc\fR(1) and \fBdebi\fR(1). +.TP +.BR DEVSCRIPTS_CHECK_DIRNAME_LEVEL ", " DEVSCRIPTS_CHECK_DIRNAME_REGEX +See the above section \fBDirectory name checking\fR for an explanation of +these variables. Note that these are package-wide configuration +variables, and will therefore affect all \fBdevscripts\fR scripts +which check their value, as described in their respective manpages and +in \fBdevscripts.conf\fR(5). +.SH "SEE ALSO" +.BR dput (1), +.BR dupload (1), +.BR devscripts.conf (5) +.SH AUTHOR +Julian Gilbey , based on the original \fBrelease\fR +script by Christoph Lameter . diff --git a/scripts/debrelease.sh b/scripts/debrelease.sh new file mode 100755 index 0000000..07c7f02 --- /dev/null +++ b/scripts/debrelease.sh @@ -0,0 +1,341 @@ +#!/bin/bash + +# debrelease: a devscripts wrapper around dupload/dput which calls +# dupload/dput with the correct .changes file as parameter. +# All command line options are passed onto dupload. +# +# Written and copyright 1999-2003 by Julian Gilbey +# Based on the original 'release' script by +# Christoph Lameter +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program. If not, see . + +set -e + +PROGNAME=`basename $0` +MODIFIED_CONF_MSG='Default settings modified by devscripts configuration files:' + +usage () { + echo \ +"Usage: $PROGNAME [debrelease options] [dupload/dput options] + Run dupload on the newly created changes file. + Debrelease options: + --dupload Use dupload to upload files (default) + --dput Use dput to upload files + -a Search for .changes file made for Debian build + -t Search for .changes file made for GNU arch + -S Search for source-only .changes file instead of arch one + --multi Search for multiarch .changes file made by dpkg-cross + --debs-dir DIR Look for the changes and debs files in DIR instead of + the parent of the current package directory + --check-dirname-level N + How much to check directory names before cleaning trees: + N=0 never + N=1 only if program changes directory (default) + N=2 always + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + --no-conf, --noconf + Don't read devscripts config files; + must be the first option given + --help Show this message + --version Show version and copyright information + +$MODIFIED_CONF_MSG" +} + +version () { + echo \ +"This is $PROGNAME, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999-2003 by Julian Gilbey, all rights reserved. +Based on original code by Christoph Lameter. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later." +} + +mustsetvar () { + if [ "x$2" = x ] + then + echo >&2 "$PROGNAME: unable to determine $3" + exit 1 + else + # echo "$PROGNAME: $3 is $2" + eval "$1=\"\$2\"" + fi +} + +# Boilerplate: set config variables +DEFAULT_DEBRELEASE_UPLOADER=dupload +DEFAULT_DEBRELEASE_DEBS_DIR=.. +DEFAULT_DEVSCRIPTS_CHECK_DIRNAME_LEVEL=1 +DEFAULT_DEVSCRIPTS_CHECK_DIRNAME_REGEX='PACKAGE(-.+)?' +VARS="DEBRELEASE_UPLOADER DEBRELEASE_DEBS_DIR DEVSCRIPTS_CHECK_DIRNAME_LEVEL DEVSCRIPTS_CHECK_DIRNAME_REGEX" + +if [ "$1" = "--no-conf" -o "$1" = "--noconf" ]; then + shift + MODIFIED_CONF_MSG="$MODIFIED_CONF_MSG + (no configuration files read)" + + # set defaults + for var in $VARS; do + eval "$var=\$DEFAULT_$var" + done +else + # Run in a subshell for protection against accidental errors + # in the config files + eval $( + set +e + for var in $VARS; do + eval "$var=\$DEFAULT_$var" + done + + for file in /etc/devscripts.conf ~/.devscripts + do + [ -r $file ] && . $file + done + + set | grep -E "^(DEBRELEASE|DEVSCRIPTS)_") + + # check sanity + case "$DEBRELEASE_UPLOADER" in + dupload|dput) ;; + *) DEBRELEASE_UPLOADER=dupload ;; + esac + + # We do not replace this with a default directory to avoid accidentally + # uploading a broken package + DEBRELEASE_DEBS_DIR="`echo \"$DEBRELEASE_DEBS_DIR\" | sed -e 's%/\+%/%g; s%\(.\)/$%\1%;'`" + if ! [ -d "$DEBRELEASE_DEBS_DIR" ]; then + debsdir_warning="config file specified DEBRELEASE_DEBS_DIR directory $DEBRELEASE_DEBS_DIR does not exist!" + fi + + case "$DEVSCRIPTS_CHECK_DIRNAME_LEVEL" in + 0|1|2) ;; + *) DEVSCRIPTS_CHECK_DIRNAME_LEVEL=1 ;; + esac + + # set config message + MODIFIED_CONF='' + for var in $VARS; do + eval "if [ \"\$$var\" != \"\$DEFAULT_$var\" ]; then + MODIFIED_CONF_MSG=\"\$MODIFIED_CONF_MSG + $var=\$$var\"; + MODIFIED_CONF=yes; + fi" + done + + if [ -z "$MODIFIED_CONF" ]; then + MODIFIED_CONF_MSG="$MODIFIED_CONF_MSG + (none)" + fi +fi + + +# synonyms +CHECK_DIRNAME_LEVEL="$DEVSCRIPTS_CHECK_DIRNAME_LEVEL" +CHECK_DIRNAME_REGEX="$DEVSCRIPTS_CHECK_DIRNAME_REGEX" + + +sourceonly= +multiarch= +debsdir="$DEBRELEASE_DEBS_DIR" + +while [ $# -gt 0 ] +do + case "$1" in + -a*) targetarch="`echo \"$1\" | sed -e 's/^-a//'`" ;; + -t*) targetgnusystem="`echo \"$1\" | sed -e 's/^-t//'`" + # dupload has a -t option + if [ -z "$targetgnusystem" ]; then break; fi ;; + -S) sourceonly=source ;; + --multi) multiarch=yes ;; + --dupload) DEBRELEASE_UPLOADER=dupload ;; + --dput) DEBRELEASE_UPLOADER=dput ;; + # Delay checking of debsdir until we need it. We need to make sure we're + # in the package root directory first. + --debs-dir=*) + opt_debsdir="`echo \"$1\" | sed -e 's/^--debs-dir=//; s%/\+%/%g; s%\(.\)/$%\1%;'`" + ;; + --debs-dir) + shift + opt_debsdir="`echo \"$1\" | sed -e 's%/\+%/%g; s%\(.\)/$%\1%;'`" + ;; + --check-dirname-level=*) + level="`echo \"$1\" | sed -e 's/^--check-dirname-level=//'`" + case "$level" in + 0|1|2) CHECK_DIRNAME_LEVEL=$level ;; + *) echo "$PROGNAME: unrecognised --check-dirname-level value (allowed are 0,1,2)" >&2 + exit 1 ;; + esac + ;; + --check-dirname-level) + shift + case "$1" in + 0|1|2) CHECK_DIRNAME_LEVEL=$1 ;; + *) echo "$PROGNAME: unrecognised --check-dirname-level value (allowed are 0,1,2)" >&2 + exit 1 ;; + esac + ;; + --check-dirname-regex=*) + regex="`echo \"$1\" | sed -e 's/^--check-dirname-level=//'`" + if [ -z "$regex" ]; then + echo "$PROGNAME: missing --check-dirname-regex parameter" >&2 + echo "try $PROGNAME --help for usage information" >&2 + exit 1 + else + CHECK_DIRNAME_REGEX="$regex" + fi + ;; + --check-dirname-regex) + shift; + if [ -z "$1" ]; then + echo "$PROGNAME: missing --check-dirname-regex parameter" >&2 + echo "try $PROGNAME --help for usage information" >&2 + exit 1 + else + CHECK_DIRNAME_REGEX="$1" + fi + ;; + --no-conf|--noconf) + echo "$PROGNAME: $1 is only acceptable as the first command-line option!" >&2 + exit 1 ;; + --dopts) shift; break ;; # This is an option for cvs-debrelease, + # so we accept it here too, even though we don't + # advertise it + --help) usage; exit 0 ;; + --version) version; exit 0 ;; + *) break ;; # a dupload/dput option, so stop parsing here + esac + shift +done + +# Look for .changes file via debian/changelog +CHDIR= +until [ -f debian/changelog ]; do + CHDIR=yes + cd .. + if [ `pwd` = "/" ]; then + echo "$PROGNAME: cannot find debian/changelog anywhere!" >&2 + echo "Are you in the source code tree?" >&2 + exit 1 + fi +done + +# Use svn-buildpackage's directory if there is one and debsdir wasn't already +# specified on the command-line. This can override DEBRELEASE_DEBS_DIR. +if [ -n "$opt_debsdir" ]; then + debsdir="$opt_debsdir" +elif [ -e ".svn/deb-layout" ]; then + buildArea="$(sed -ne '/^buildArea=/{s/^buildArea=//; s%/\+%/%g; s%\(.\)/$%\1%; p; q}' .svn/deb-layout)" + if [ -n "$buildArea" -a -d "$buildArea" ]; then + debsdir="$buildArea" + fi +fi + +# check sanity of debsdir +if ! [ -d "$debsdir" ]; then + if [ -n "$debsdir_warning" ]; then + echo "$PROGNAME: $debsdir_warning" >&2 + exit 1 + else + echo "$PROGNAME: could not find directory $debsdir!" >&2 + exit 1 + fi +fi + +mustsetvar package "`dpkg-parsechangelog -SSource`" "source package" +mustsetvar version "`dpkg-parsechangelog -SVersion`" "source version" + +if [ $CHECK_DIRNAME_LEVEL -eq 2 -o \ + \( $CHECK_DIRNAME_LEVEL -eq 1 -a "$CHDIR" = yes \) ]; then + if ! perl -MFile::Basename -w \ + -e "\$pkg='$package'; \$re='$CHECK_DIRNAME_REGEX';" \ + -e '$re =~ s/PACKAGE/\\Q$pkg\\E/g; $pwd=`pwd`; chomp $pwd;' \ + -e 'if ($re =~ m%/%) { eval "exit (\$pwd =~ /^$re\$/ ? 0:1);"; }' \ + -e 'else { eval "exit (basename(\$pwd) =~ /^$re\$/ ? 0:1);"; }' + then + echo >&2 </dev/null | head -1) + +if [ -n "$multiarch" ]; then + if [ -z "$mchanges" -o ! -r "$mchanges" ]; then + echo "$PROGNAME: could not find/read any multiarch .changes file with name" >&2 + echo "$debsdir/${package}_${sversion}_*.changes" >&2 + exit 1 + fi + changes=$mchanges +elif [ "$arch" = source ]; then + if [ -r "$schanges" ]; then + changes=$schanges + else + echo "$PROGNAME: could not find/read changes file $schanges!" >&2 + exit 1 + fi +else + if [ ! -r "$changes" ]; then + if [ -r "$mchanges" ]; then + changes=$mchanges + echo "$PROGNAME: could only find a multiarch changes file:" >&2 + echo " $mchanges" >&2 + echo -n "Should I upload this file? (y/n) " >&2 + read ans + case ans in + y*) ;; + *) exit 1 ;; + esac + else + echo "$PROGNAME: could not read changes file $changes!" >&2 + exit 1 + fi + fi +fi + +exec $DEBRELEASE_UPLOADER "$@" "$changes" + +echo "$PROGNAME: failed to exec $DEBRELEASE_UPLOADER!" >&2 +echo "Aborting...." >&2 +exit 1 diff --git a/scripts/debrepro.pod b/scripts/debrepro.pod new file mode 100644 index 0000000..3e6aa60 --- /dev/null +++ b/scripts/debrepro.pod @@ -0,0 +1,158 @@ +=head1 NAME + +debrepro - reproducibility tester for Debian packages + +=head1 SYNOPSIS + +B [I] [I] + +=head1 DESCRIPTION + +B will build a given source directory twice, with a set of +variations between the first and the second build, and compare the +produced binary packages. If B is installed, it is used to +compare non-matching binaries. If B is installed, it is used +during the build to inject non-determinism in filesystem listing +operations. + +I must be a directory containing an unpacked Debian source +package. If I is omitted, the current directory is assumed. + +=head1 OUTPUT DIRECTORY + +At the very end of a build, B will inform the location of the +output directory where the build artifacts can be found. In that +directory, you will find: + +=over + +=item I<$OUTPUTDIR/first> + +Contains the results of the first build, including a copy of the source +tree, and the resulting binary packages. + +=item I<$OUTPUTDIR/first/build.sh> + +Contains the exact build script that was used in the first build. + +=item I<$OUTPUTDIR/second> + +Contains the results of the second build, including a copy of the source tree, +and the resulting binary packages. + +=item I<$OUTPUTDIR/second/build.sh> + +Contains the exact build script that was used in the second build. + +=back + +Taking a B between I<$OUTPUTDIR/first/build.sh> and +I<$OUTPUTDIR/second/build.sh> is an excellent way of figuring out +exactly what changed between the two builds. + +=head1 SUPPORTED VARIATIONS + +=over + +=item B + +The I<$USER> environment variable will contain different values between the +first and second builds. + +=item B + +During the second build, a fake, non-existing directory will be appended to the +I<$PATH> environment variable. + +=item B + +The builds will use different umask settings. + +=item B + +Both I<$LC_ALL> and I<$LANG> will be different across the two builds. + +=item B + +I<$TZ> will be different across builds. + +=item B + +If B is installed, both builds will be done under a disorderfs +overlay directory. This will cause filesystem listing operations to be return +items in a non-deterministic order. + +=item B