From owner-freebsd-ports Mon Sep 3 8:26:29 2001 Delivered-To: freebsd-ports@freebsd.org Received: from pelissero.org (dyn139-32.sftm-212-159.plus.net [212.159.32.139]) by hub.freebsd.org (Postfix) with ESMTP id D5D6F37B40D for ; Mon, 3 Sep 2001 08:25:46 -0700 (PDT) Received: (from wcp@localhost) by pelissero.org (8.11.6/8.9.3) id f83FPUX98503; Mon, 3 Sep 2001 16:25:30 +0100 (BST) (envelope-from wcp) From: "Walter C. Pelissero" Message-ID: <15251.41194.263326.342721@hyde.lpds.sublink.org> Date: Mon, 3 Sep 2001 16:25:30 +0100 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="kM2hXAkMff" Content-Transfer-Encoding: 7bit To: freebsd-ports@freebsd.org Subject: a couple of utilities X-Mailer: VM 6.90 under 21.1 (patch 13) "Crater Lake" XEmacs Lucid Reply-To: walter@pelissero.org X-Attribution: WP Sender: owner-freebsd-ports@FreeBSD.ORG Precedence: bulk List-ID: List-Archive: (Web Archive) List-Help: (List Instructions) List-Subscribe: List-Unsubscribe: X-Loop: FreeBSD.org --kM2hXAkMff Content-Type: text/plain; charset=us-ascii Content-Description: message body text Content-Transfer-Encoding: 7bit Recently after messing around with ports, packages and cvsup I've written a couple of utilities. The first removes (or helps to remove) outdated distfiles left around. The second looks for binaries that are not runnable anymore because of a missing shared library (careless use of pkg_delete -f). Hope you find them interesting. ( You need scsh 0.5.2 or better to run them. ) --kM2hXAkMff Content-Type: text/plain Content-Disposition: inline; filename="clean-port-distfiles" Content-Transfer-Encoding: 7bit #!/usr/local/bin/scsh \ -dm -m program -e main -s !# ;;; clean-port-distfiles.scm --- remove old distfiles ;;; Copyright (C) 2001 by Walter C. Pelissero ;;; Author: Walter C. Pelissero ;;; Project: ;;; $Id$ ;;; 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; see the file COPYING. If not, write to ;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; This program is a helper to keep FreeBSD ports tree tidy and not ;;; waste space in storing outdated distfiles (usually in ;;; /usr/ports/distfiles). ;;; If your preferred way of keeping your system up to date is cvsup ;;; you may end up, after a while, with several version of your ;;; preferred software's distribution files. To avoid spending a day ;;; browsing through /usr/ports/distfiles and figure out what is ;;; necessary and what is not this program does it for you. It goes ;;; through all the package Makefiles and make a list of what the ;;; current ports snapshot require and then removes the distfiles that ;;; are not necessary any more. ;;; If you don't trust the program (I wouldn't if I were in you), ;;; tuning the verbosity level you can avoid the automatic deletion of ;;; the files or even skip the deletion process altogether. ;;; You need Scsh 0.5.2 or better to run this program. ;;; Type "clean-port-distfiles --help" to get an usage description. (define-structure program (export main) (open scheme scsh big-scheme) (begin (define-syntax when (syntax-rules () ((when ?test ?body ...) (if ?test (begin ?body ...))))) (define-syntax unless (syntax-rules () ((unless ?test ?body ...) (when (not ?test) ?body ...)))) (define *ports-dir* "/usr/ports") (define *distfiles-dir* (path-list->file-name (list *ports-dir* "distfiles"))) (define *makefile* "Makefile") (define *verbosity* 'medium) ; quiet, low, medium, high, ; list, or debug (define (make-circular! list) (let loop ((l list)) (cond ((null? l) '()) ; can't be made circular ((null? (cdr l)) (set-cdr! l list)) (else (loop (cdr l)))))) (define (circular-list . args) (make-circular! args) args) (define (display-debug-info fmt . args) (cond ((equal? *verbosity* 'debug) (apply format #t fmt args) (newline)))) (define (extract-distfiles-from-makefile distfiles) (let ((reader (field-reader (infix-splitter (rx (+ white))))) (in (run/port (| (begin (display "scsh-print-allfiles:\n\t@echo $(ALLFILES)\n")) (cat ,*makefile* -) (make -f - scsh-print-allfiles))))) (let loop () (receive (line fields) (reader in) (unless (eof-object? line) (display-debug-info "\t+ ~a = ~s" line fields) (for-each (lambda (f) (table-set! distfiles f #t)) fields) (loop)))) (close-input-port in))) (define (display-processed-category category) (case *verbosity* ((low) (display ".") (force-output)) ((medium) (display category) (display " ") (force-output)) ((high debug) (display category) (display ":") (newline)))) (define display-processed-package (let* ((phases (circular-list #\- #\\ #\| #\/))) (lambda (package) (case *verbosity* ((low medium) (display (car phases)) (display "\b") (force-output) (set! phases (cdr phases))) ((high debug) (display "\t") (display package) (newline)))))) (define (get-all-distfiles-in-package dir distfiles) (when (and (file-directory? dir) (file-exists? (path-list->file-name (list dir *makefile*)))) (with-cwd dir (display-processed-package dir) (extract-distfiles-from-makefile distfiles)))) (define (get-all-distfiles-in-category dir distfiles) (when (file-directory? dir) (with-cwd dir (display-processed-category dir) (for-each (lambda (package) (get-all-distfiles-in-package package distfiles)) (directory-files "."))))) (define (get-all-distfiles-in-all-categories) (let ((distfiles (make-string-table))) (with-cwd *ports-dir* (for-each (lambda (cat) (get-all-distfiles-in-category cat distfiles)) (directory-files "."))) distfiles)) (define (confirm? fmt . args) (apply format #t fmt args) (display "? (y/n) ") (force-output) (case (string->synbol (read-line)) ((y yes) #t) (else #f))) (define (expunge-file file) (case *verbosity* ((quiet) (delete-file file)) ((low) (format #t "rm ~a" file) (newline) (delete-file file)) ((medium) (if (confirm? "delete ~a" file) (delete-file file))) ((high) (if (confirm? "delete ~a (~a ~a)" file (file-size file) (file-last-mod file)) (delete-file file))) ((list) (display file) (newline)) ((debug) (format #t "would delete ~a (~a ~a)" file (file-size file) (file-last-mod file)) (newline)))) (define (delete-if-not-necessary file needed-ones) (cond ((file-directory? file) (delete-dist-files-but file needed-ones)) ((table-ref needed-ones file) #f) (else (expunge-file file)))) (define (delete-dist-files-but dir necessary-distfiles) (with-cwd dir (for-each (lambda (f) (delete-if-not-necessary f necessary-distfiles)) (directory-files ".")))) (define (usage args) (let ((p (file-name-nondirectory (car args)))) (format #t "usage: ~a [options] options are: --verbosity level -v level set verbosity level to one of the following (default medium): quiet no process indicator, delete without asking low process indicator and delete without asking medium process indicator, list of categories, and ask before deletion high list of categories and packages; ask before deletion list don't delete, just print a list of files to be deleted debug don't delete, but be extra verbose on processing phases --list-only -l same as -v list --debug same as -v debug --port-directory dir -d dir set port directory to dir (default /usr/ports) " p)) (exit 1)) (define (parse-args args) (let loop ((l (cdr args))) (if (null? l) '() (case (string->symbol (car l)) ((-v --verbosity) (set! *verbosity* (string->symbol (cadr l))) (loop (cddr l))) ((-d --ports-directory) (set! *ports-dir* (cadr l)) (loop (cddr l))) ((-l --list-only) (set! *verbosity* 'list) (loop (cdr l))) ((--debug) (set! *verbosity* 'debug) (loop (cdr l))) ((-h -help --help) (usage args)) (else l))))) (define (main args) (parse-args args) (delete-dist-files-but *distfiles-dir* (get-all-distfiles-in-all-categories))))) ;;; ;;; Leave the following lines at end of file. ;;; ;;; Local Variables: ;;; mode:scheme ;;; scheme-program-name:"scsh" ;;; End: --kM2hXAkMff Content-Type: text/plain Content-Disposition: inline; filename="find-broken-bins" Content-Transfer-Encoding: 7bit #!/usr/local/bin/scsh \ -dm -m program -e main -s !# ;;; find-broken-bins.scm --- find binaries that miss some library ;;; Copyright (C) 2001 by Walter C. Pelissero ;;; Author: Walter C. Pelissero ;;; Project: ;;; $Id$ ;;; 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; see the file COPYING. If not, write to ;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;; Commentary: (define-structure program (export main) (open scheme scsh) (begin (define-syntax when (syntax-rules () ((when ?test ?body ...) (if ?test (begin ?body ...))))) (define-syntax unless (syntax-rules () ((unless ?test ?body ...) (when (not ?test) ?body ...)))) (define *verbosity* 'low) ; low, high, or debug (define-syntax on-exit (syntax-rules () ((close-on-exit ?form ?body ...) (dynamic-wind (lambda () #f) (lambda () ?body ...) (lambda () ?form))))) (define (call-with-input-port port proc) (on-exit (close-input-port port) (proc port))) (define (display-debug-info fmt . args) (cond ((equal? *verbosity* 'debug) (apply format #t fmt args) (newline)))) (define parse-ldd-output (let ((reader (field-reader (field-splitter (rx (+ (~ white))))))) (lambda (port) (awk (reader port) (line fields) ((missing-libraries '())) ((: "not found") (cons (car fields) missing-libraries)))))) (define (missing-libraries file) (call-with-input-port (run/port (ldd ,file) (- 2)) parse-ldd-output)) (define (check-if-broken file) (display-debug-info "checking ~a" file) (cond ((and (file-symlink? file) (file-not-exists? file #t)) (format #t "~a is a broken symbolic link" file) (newline) (case *verbosity* ((high debug) (run (pkg_info -W ,file))))) ((file-regular? file) (let ((libs (missing-libraries file))) (when (pair? libs) (format #t "~a depends on missing libraries ~a" file libs) (newline) (case *verbosity* ((high debug) (run (pkg_info -W ,file))))))))) (define (look-in dir) (for-each (lambda (f) (check-if-broken (path-list->file-name (list dir f)))) (directory-files dir))) (define (search-for-broken-binaries paths) (for-each look-in paths)) (define (usage args) (let ((p (file-name-nondirectory (car args)))) (format #t "usage: ~a [options][dir ...] options are: --verbosity level -v level set verbosity level to one of the following (default low): low don't check packages high check packages debug show what it's doing --debug -d same as -v debug If no argument is passed PATH envvar is used. " p)) (exit 1)) (define (parse-args args) (let loop ((l (cdr args))) (if (null? l) '() (case (string->symbol (car l)) ((-v --verbosity) (set! *verbosity* (string->symbol (cadr l))) (loop (cddr l))) ((-d --debug) (set! *verbosity* 'debug) (loop (cdr l))) ((-h -help --help) (usage args)) (else l))))) (define (main args) (let ((paths (parse-args args))) (search-for-broken-binaries (if (null? paths) ((infix-splitter (rx #\:)) (getenv "PATH")) paths)))))) ;;; ;;; Leave the following lines at end of file. ;;; ;;; Local Variables: ;;; mode:scheme ;;; scheme-program-name:"scsh" ;;; End: --kM2hXAkMff Content-Type: text/plain; charset=us-ascii Content-Description: .signature Content-Transfer-Encoding: 7bit -- walter pelissero http://www.pelissero.org --kM2hXAkMff-- To Unsubscribe: send mail to majordomo@FreeBSD.org with "unsubscribe freebsd-ports" in the body of the message