Date: Mon, 3 Sep 2001 16:25:30 +0100 From: "Walter C. Pelissero" <walter@pelissero.org> To: freebsd-ports@freebsd.org Subject: a couple of utilities Message-ID: <15251.41194.263326.342721@hyde.lpds.sublink.org>
next in thread | raw e-mail | index | archive | help
--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 <walter@pelissero.org>
;;; 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 <walter@pelissero.org>
;;; 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
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?15251.41194.263326.342721>