[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

managment of a full file partition




 Several weeks ago, I encountered the following problem:

 the partition of our server machine was full and we didn't know what
room occupied our different directories. I looked at the documentation and
I didn't find any useful tool. But the problem was really annnoying and
slowed down our work. Finally I decided to write a such tool by myself.

  The following program calculates the room occupied by the files specified
by a given name, including the ones contained in subdirectories. It also
calculates the relative occupation of each subdirectory of a given
directory, compared to the one of all the specified files or directories.

For example, (examine-size-of-directory-tree "Host:>")
calculates the room occupied by all the files contained in "Host:>",
included the ones which are in subdirectories. It also calculate and print
the relative occupation of each direct subdirectory of "Host:>" (incliding
the files contained in subdirectories of the examined direct subdirectries).

For example, "Host:>rel-7-2>" may occupy 30% of the room of the one used by
"Host:>"

NOTE: some lines have been shifted to fit in 80 columns for mailing reasons.

--------------------Cut Here ---------------- Cut Here ----------------------
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10 -*-

;;;*************************************************************************
;;;
;;; Emmanuel Baechler 2/03/89
;;;     Artificial Intelligence Laboratory
;;;     Computer Science Department
;;;     Ecole Polytechnique Federale de Lausanne
;;;     MA - (Ecublens)
;;;     1015 LAUSANNE Switzerland
;;;     E-MAIL:  BAECHLER@ELMA.EPFL.CH (.BITNET)
;;;
;;; Tools to get some statistics about the file system:
;;;  what is the the room that occupy the different file of a given
;;;  directory (files of subdirectories included) ?
;;;
;;;  the name of the file (directory) to explore must be given as a string.
;;;  It correctly handles simple files (non directory), directories in which
;;;  the last ">" has been forgotten and wild cards (as far as I have seen).
;;;
;;;  Statistics of the room used are printed by defalut at one level. It
;;; prints the whole amount used by a directory and the absolute and relative
;;; room used by the direct subdirectories of the one to explore.
;;;
;;;  A function intended to give recursive statistics exists and
;;;  works. I don't know if it is really useful: statistics of a
;;;  deep tree structure will give a huge output and won't be very readable.
;;;
;;;  1 record = 1152 * 32 bits = 4608 bytes (of 8 bits)
;;;
;;;  NOTES: _ links to files and directories are not handled.
;;;         _ Only Symbolics File Names are supported.
;;;         _ As far as I Have seen wildcards and non directory files
;;;           are handled correctly.
;;;
;;;  The following fuctions are the user interface of that tool. For
;;;  documentation look at each function in the source or use the
;;;  'documentation' function.
;;;
;;;  *trace-processing*   Defalut: TRUE          Variable
;;;    When true, traces the exploration of the file tree by printing
;;;  the name of each directory examined with the proper indentation.
;;;    When NIL nothing is printed while exploring the tree.
;;;
;;;  (calculate-total-size <Pathname>)
;;;
;;;  (calculate-directory-statistics <directory-tree>)
;;;
;;;  Directory tree have the following form:
;;;  (<Directory-Name> <Byte-Size> <Block-Size>
;;;     {( [+ <Subdirectory-tree> +]) | NIL})
;;;
;;; <Directory-Name> ::== a string
;;;
;;;  <Byte-Size> ::== size in bytes (of 8 bits) of all the files inside
;;;                   the directory, even the ones in a subdirectory.
;;;                   Directory files are considered of size 0.
;;;
;;;  <Block-size> ::== Total number of records allocated for the file in
;;;                    the examined directory multiplied by the number of
;;;                    bytes (of 8 bits) a record contains (4608 bytes).
;;;                    directory files are taken in account in that case.
;;;
;;;  The difference of the managment of directory files between the <Byte-Size>
;;;  and the <Block-Size> is due to the fact that directories have neither
;;;  :length-in-bytes properties nor :byte-length one.
;;;
;;;  If there is no subdirectory, the fourth element of the directory tree is
;;;  NIL.
;;;
;;;  (calculate-recursive-directory-statistics <directory-tree>)
;;;
;;;  (examine-size-of-directory-tree <Pathname> [:output-stream <File-Name>]
;;;                                             [:recursive <Flag>])
;;;
;;;  (find-subdirectory <Directory-Name> <directory-tree>)
;;;
;;;  Find-subdirectory  allows not to have to recall Calculate-total-size
;;;  on Host:>rel-7-2>, for example, if you have just used it for Host:>.
;;;  It allows to reuse the examination done for a given subdirectory
;;;  for one of its subdirectory:
;;;
;;;  (setq dir-tree (calculate-total-size "Host:>")
;;;  ....
;;;  (calculate-directory-statistics (find-subdirectory "Host:>rel-7-2>"))
;;;
;;;  OR:
;;;
;;;  (setq dir-tree (examine-size-of-directory-tree "Host:>")
;;;  ;; The result returned by examine-size-of-directory-tree is the one of
;;;  ;; calculate-total-size
;;;  ....
;;;  (calculate-directory-statistics (find-subdirectory "Host:>rel-7-2>"))
;;;
;;;**************************************************************************

(defvar *trace-processing* t
 "used to allow of forbid the trace of the processing of the tree examination")
;;; used by calculate-total-size
;;;   Slower when true, but allows to see that the tools works and where it
;;; is currently.

(defvar *record-size* 4608
  "length in bytes (of 8 bits) of a record of an LFMS partition")
;;; Vol 5. 6.7.1 Free records, P. 192

(defun calculate-total-size (directory)
  "(calculate-total-size <file-name>)        Function
   Calculate the total size of the files contained in a directory, including
   the files contained in subdirectories.
   <File-name> must be a string. 'Directory strings' are recognised by the fact
   that they finish with a '>', but directories supplied without the last '>'
   will also be recognised.
   If <file-name> is not the name of a directory, all the files corresponding
   to the filname supplied are used, even if <file-name> contains wildcards.
   Some of these files may be directories and will be handled properly: the
   files that they contain will be used."
  (calculate-total-size-1 directory 0))

;;; examines recursively all the files included in a given directory.
(defun calculate-total-size-1 (directory depth)
  (let ((total-size 0)
        (total-block-size 0)
        (partial-size-list nil)
        (x nil)
        (file-list (fs:directory-list directory)))
    (when *trace-processing*
      (format *trace-output*
              ;; indirect relative tabulation is a shit !
              (strcat "~% ~"
                               (number-to-string (* depth 2))
                               ",1@T Processing: ~S")
              directory))
    (if (pathname-of-directory-p directory)
        ;; handle files and subdirectories
        (dolist (file (cdr file-list)
                      (list directory total-size total-block-size
                            partial-size-list))
          ;;if 'File' is a file adds its size. If it is a directory,
          ;;adds the size of the directory-file itself. Still need to
          ;;add the size of subfiles and subdirectories.
          (setq total-block-size (+ total-block-size (block-size file)))
          (if (not (directory-p file))
              (setq total-size (+ total-size (file-size file)))
              ;; else it is a directory: calculate its own partial size
              (progn
                (setq x (calculate-total-size-1
                          (strcat directory (pathname-name (car file)) ">")
                          (1+ depth)))
                (setq total-size (+ total-size (second x)))
                (setq total-block-size (+ total-block-size (third x)))
                (setq partial-size-list (append partial-size-list (list x))))))
        ;; '<directory>' is the pathname of a file and not of a directory
        (if (= (length file-list) 2)
            ;; only one file: no wildcard
            (if (directory-p (cadr file-list))
                ;; ex: "cook:>hk" in that case, we must simply add ">" to the
                ;; directory name. There are no other case in which a file is
                ;; a direcrtory but does not appear as so.
                (calculate-total-size-1 (strcat directory ">") depth)
                (list directory (file-size (cadr file-list))
                      (block-size (cadr file-list)) nil))
            ;; use of wildcard: must process them, still need to take account
            ;; of subdirectories: some files in the file-list may be
            ;; subdirectories. If directory is a wildcard one, subfiles will
            ;; be immediately supplied and processed in the previous part of
            ;; the function: (pathname-of-directory-p directory) will be true.
            (dolist (file (cdr file-list)
                          (list directory total-size total-block-size
                                partial-size-list))
              ;; considering the file itself
              (setq total-block-size (+ total-block-size (block-size file)))
              (if (not (directory-p file))
                  (setq total-block-size (+ total-block-size (file-size file)))
                  ;; else it is a directory: calculate its own partial size
                  (progn
                    (setq x (calculate-total-size-1
                              (strcat directory (pathname-name (car file)) ">")
                              (1+ depth)))
                    (setq total-size (+ total-size (second x)))
                    (setq total-block-size (+ total-block-size (third x)))
                    (setq partial-size-list
                          (append partial-size-list (list x))))))))))


(defun pathname-of-directory-p (pathname)
  ;; a 'directory string' is recognised by the fact that its
  ;; last character is a ">"
  (when (stringp pathname)
    (let ((long (length pathname)))
      (equal (subseq pathname (1- long) long) ">"))))

(defun directory-p (file-att)
  ;; look at the p-list returned by fs:directory-list
  (member :directory file-att))

(defun file-size (file-att)
  ;; look at the p-list returned by fs:directory-list
  ;; directory files are counted for 0.
  (let ((byte-size (cadr (member :byte-size file-att)))
        (length-in-bytes (cadr (member :length-in-bytes file-att))))
    (if byte-size
        (if (= byte-size 8)
            length-in-bytes
            ;; else byte-size is 16 bits, i.e. 2 bytes
            (* length-in-bytes 2))
        0)))

(defun block-size (file-att)
  ;; space in bytes (of 8 bits) really allocated in the file
  ;; system for a given file.
  (let ((block-size (cadr (member :length-in-blocks file-att))))
    (* block-size *record-size*)))

(defun calculate-directory-statistics (directory-list)
  "(calculate-directory-statistics <directory-tree>)    Function
     Prints the total size in bytes occupied by a given <directory-tree>
   included its subdirectories and files. Prints also the total size
   allocated to that <directory-tree>.
     Then, prints the absolute and relative size occupied by each direct
   subdirectory of <directory-tree> and the relative size allocated to
   each of them (compared to the one allocated to the main directory."
  (let ((directory-name (first  directory-list))
        (directory-size (second directory-list))
        (directory-block-size (third directory-list))
        (subdirectories (cadddr   directory-list))
        (total-size 0)
        (total-block-size 0)
        (x 0)
        (y 0))
    (format t
        "~%~% examining: ~S, size: ~S bytes,  blocks occupation ~S bytes  ~%~%"
        directory-name directory-size directory-block-size)
    (dolist (subdirectory subdirectories directory-list)
      ;; used size
      (setq x (coerce (* (/ (second subdirectory) directory-size) 100)
                      'long-float))
      ;; size in blocks
      (setq y (coerce (* (/ (third subdirectory) directory-block-size) 100)
                      'long-float))
      (setq total-size (+ total-size x))
      (setq total-block-size (+ total-block-size y))
      (format t
"~% directory: ~S size: ~S relative-size: ~5,2F %  Relative occupation ~5,2F %"
              (first subdirectory)
              (second subdirectory)
              x y))
    (format t
            "~%~%  total relative size of the subdirectories: ~5,2F %"
            total-size)
    (format t
            "~%~%  total relative occupation of the subdirectories: ~5,2F %"
            total-block-size)))

(defun calculate-recursive-directory-statistics (directory-list)
  (calculate-recursive-directory-statistics-1 directory-list 0))


(defun calculate-recursive-directory-statistics-1 (directory-list depth)
  "(calculate-recursive-directory-statistics <directory-tree>)    Function
   Does the same than 'calculate-directory-statistics' but does also print
   statistics about the subdirectories. The output produced is not really
   useful (readable)"
  ;; display the relative size of the subdirectories of directory-list
  ;; compared to the global size.
  (let ((directory-name (first  directory-list))
        (directory-size (second directory-list))
        (directory-block-size (third directory-list))
        (subdirectories (cadddr   directory-list))
        (total-size 0)
        (total-block-size 0)
        (x 0)
        (y 0))
    (format t
            (strcat
              "~%~%~"
              (number-to-string (* depth 2));halas, indirect relative tabbing
 ",1@T examining: ~S, Total size: ~S bytes,  blocks occupation ~S bytes  ~%~%")
            directory-name directory-size directory-block-size)
    (dolist (subdirectory subdirectories directory-list)
      ;; used size
      (setq x (coerce (* (/ (second subdirectory) directory-size) 100)
                      'long-float))
      ;; size in blocks
      (setq y (coerce (* (/ (third subdirectory) directory-block-size) 100)
                      'long-float))
      (setq total-size (+ total-size x))
      (setq total-block-size (+ total-block-size y))
      (format t
              (strcat
                "~%~"
                (number-to-string (* depth 2));halas,indirect relative tabbing
     ",1@T directory: ~S size: ~S rel. size: ~5,2F %  Rel. occupation ~5,2F %")
              (first subdirectory)
              (second subdirectory)
              x y)
      (calculate-recursive-directory-statistics-1 subdirectory (1+ depth)))
    (format t
            (strcat
              "~%~%~"
              (number-to-string (* depth 2));halas, indirect relative tabbing
              ",1@T  total relative size of the subdirectories: ~5,2F")
            total-size)
    (format t
            (strcat
              "~%~%~"
              (number-to-string (* depth 2));halas, indirect relative tabbing
              ",1@T  total relative occupation of the subdirectories: ~5,2F")
            total-block-size)))



(defun examine-size-of-directory-tree (directory
                                       &key (output-stream *terminal-io*)
                                       (recursive nil))
  "(examine-size-of-directory-tree <Directory> [:output-stream <stream>]
                                               [:recursive <flag>])
   First calculates the total size occupied by a given directory, then
   calculates and print the statistics corresponding to the file tree
   examined.  If :recursive is supplied and not null, the printing is
   recursive. If an output stream not EQ to *terminal-io* nor TO
   *standard-output* The output is put in the <stream> file. If it
   already exists, a new version is created.

  The default for :output-stream is *terminal-io* and for :recursive
  it is NIL.
  Returns the directory tree produced by the calculation of the total
  size."
  (redirect-output output-stream
    (let ((directory-tree (calculate-total-size directory)))
      (if recursive
          (calculate-recursive-directory-statistics directory-tree)
          (calculate-directory-statistics directory-tree))
      directory-tree)))


(defun find-subdirectory (directory-name directory-tree)
  "(find-subdirectory <Name> <directory-tree>)        Function
   Returns the directory tree corresponding to <name> if <name>
   is the one of a subdirectory included (at any level) in <directory-tree>.
   Otherwise returns NIL."
  (if (string-equivalent directory-name (car directory-tree))
      directory-tree
      (let* ((subdirectories (cadddr directory-tree)))
             (when (not (null subdirectories))
               (find-subdirectory-1 directory-name subdirectories)))))

(defun find-subdirectory-1 (directory-name directory-list)
  (when (not (null directory-list))
    (let ((x (find-subdirectory directory-name (car directory-list))))
      (if x
          x
          (find-subdirectory-1 directory-name (cdr directory-list))))))

(defun string-equivalent (str1 str2)
  (string= (string-upcase str1) (string-upcase str2)))




(defun strcat (&rest nice)
  "(strcat [* <strings> *])
   Concatenates the argument strings. When no string is supplied,
   returns the null string"
  (eval `(concatenate 'string ,@(mapcar #'string-upcase nice))))

(defun number-to-string (number)
  "(number-to-string <Number>)
   Returns Number as a string. If <number> is not a number,
   an error occurs"
  (if (numberp number)
      (format nil "~S" number)
      (error "~% ~S is not a number" number)))

(defmacro redirect-output (out-file &body body)
  "(redirect-output <In-File> <Body>)              Macro
   Performs a robust redirection of the output file: if out-file is NIL,
   there is no redirection. If not, *standard-output* is temporarily rebound
   as out-file. The redirection is cancelled and the file closed when BODY
   has been executed.
     When Out-file does already exist, a new version is created.
   if out-file is eq to *standard-output* or *terminal-io* no redirection is
   done."
  `(if  (and ,out-file
             (neq ,out-file *standard-output*)
             (neq ,out-file *terminal-io*))
       (with-open-file (*standard-output* ,out-file :direction :output
                                                    :if-exists :new-version
                                                    :if-does-not-exist :create)
         ,@BODY)
       ,@BODY))