;;; ;;; depot.el ;;; ;;; This file implements some functions for maintaining a /depot ;;; package scheme. ;;; ;;; For amd, we want to do as much load balancing as possible. ;;; This file helps compute the best amd map on a per-host basis. ;;; With these tools it should be possible to drop in a /depot ;;; package anywhere on our net, and then recreate individualized ;;; amd /depot maps automatically. ;;; ;;; This includes other functions for maintaining our depot system, ;;; in particular, backup and rdist scripts; perhaps later /etc/exports, ;;; and /.rhosts for rdist. ;;; ;;; Need to remember: get rid of rdist of wp...for now, we don't do ;;; printers sensibly. (require 'cl) ;;; Important variables for customizing our depot setup. ;; (defvar *ucet-topology* ;; '((((gibson vertov) (angelou brecht) (stein keaton) (godard hooks) (jarry benjamin)) trinh barthes) (haraway (ronell melies))) ;; "The topology of our network layout based on subnetting, existance of gateways and bridges, as well as preference.") (setq *ucet-topology* '((gibson vertov) (benjamin jarry) (stein keaton) (angelou brecht) (hooks godard) ronell (haraway melies barthes)))) ;; ;; For the incredible shrinking 3.2.5 system ;; ;;(setq *ucet-topology* ;; '((barthes melies trinh) ronell haraway)) (setq *amd-standard-header* (concat "/defaults " "cache:=all,sync;\n" "mail " "-opts:=rw,hard,noac,intr,utimeout=900,grpid,nosuid,nodevs,noquota;" "remopts:=rw,hard,noac,intr,utimeout=900,grpid,nosuid,nodevs,noquota," "timeo=20,retrans=5,rsize=1024,wsize=1024 " ;; Note trailing space! "host!=gibson;rhost:=gibson;rfs:=/var/spool/mail;type:=nfs;fs:=${autodir}/${rhost}/${key/}" "\n")) ;;;; "The standard defaults for our amd /depot entries, as well as boiler plate stuff.") ;;;; ;;; This should be done here. Instead, it is done at the end... ;;; ;;; (setq *ucet-hosts* (sort (flatten *ucet-topology*) '(lambda (x y) (string-lessp x y)))) ;;; ;;; or we could do it here static: ;;; ;;; '(angelou barthes benjamin brecht gibson godard haraway hooks jarry keaton melies ronell stein trinh vertov) (defvar *depot-default-package-options* "-opts:=ro,soft,intr,grpid,nosuid,nodevs,noquota;remopts:=ro,soft,intr,grpid,nosuid,nodevs,noquota,timeo=20,retrans=5,rsize=8192,wsize=8192" "Default mount options for amd depot map") (defvar *depot-package-options-alist* '(("images" . "-opts:=rw,hard,intr,grpid,nosuid,nodevs,noquota;remopts:=rw,hard,intr,grpid,nosuid,nodevs,noquota,timeo=20,retrans=5,rsize=8192,wsize=8192")) "Specialized mount options for selected packages. Use default if package is not on this list.") ;;; TOPOLOGIES FUNCTIONS ;;; ;;; ``Topologies'' are just nested lists that show how our network is organized. ;;; These utilities simply provide, for a given host, a list of all the hosts ;;; on the network ordered by distance, from the least distance (the given host ;;; itself), to the farthest. The main routine of importance here is ;;; ;;; depot-nearest-hosts host list (of symbols) of all hosts, in order ;;; of distance from supplied host. ;;; ;;; Utilities for dealing with a network topology structure: (defun rotate-list (list) "rotate the elements of a list, once to the left." (if (not list) nil (append (cdr list) (cons (car list) nil)))) (defun flatten (list) "flatten out the LIST substructure into a simple list, preserving the left-to-right ordering." (flatten-1 list nil)) (defun flatten-1 (list flattened) "helper function for flatten." (cond ((null list) flattened) ((atom list) (cons list flattened)) (t (append (flatten-1 (car list) flattened) (flatten-1 (cdr list) nil))))) (defun sub-member (elt list) "Like member, but descends into the LIST searching for ELT. Uses eq." (cond ((null list) nil) ((atom list) (eq elt list)) (t (or (sub-member elt (car list)) (sub-member elt (cdr list)))))) (defun reorder-topology (host topology) "reorders via successive rotations TOPOLOGY, a nested list of hosts, until HOST is at the front." (cond ((null topology) nil) ((atom topology) topology) (t (if (sub-member host (car topology)) (cons (reorder-topology host (car topology)) (cdr topology)) (reorder-topology host (rotate-list topology)))))) (defun depot-nearest-hosts (host) "list all the hosts in our network, with the ``nearest'' to HOST first. A list of symbols is returned." (if (not (sub-member host *ucet-topology*)) (error "depot-nearest-hosts: host %s is not present in %s." host *ucet-topology*)) (flatten (reorder-topology host *ucet-topology*))) ;;; DEPOT PACKAGES ;;; ;;; Depot packages are the concern of the next section. The important ;;; routines are: ;;; ;;; depot-packages return a list of all the packages ;;; depot-list-host-packages host ;;; (defun depot-list-host-packages (host) "return a list of strings, the packages supplied by HOST via rsh listing of /exp/depot, which should contain only directories ready to be exported to ucet.ufl.edu." (depot-locate-all-packages) (let ((buff (get-buffer-create " *rsh output* ")) (packages nil) (package "")) (save-excursion (set-buffer buff) (delete-region (point-min) (point-max)) (call-process "/usr/bin/rsh" nil buff nil (format "%s" host) "/usr/bin/ls" "-1F" "/exp/depot") (goto-char (point-min)) (while (re-search-forward "^\\(.*\\)/$" nil t) (setq package (buffer-substring (match-beginning 1) (match-end 1))) (if (not (string-equal "lost+found" package)) (setq packages (cons package packages)))) (reverse packages)))) (defun depot-packages () "return a list of all depot packages at ucet.ufl.edu." (depot-locate-all-packages) (let ((packages nil) (uniqs nil)) (dolist (host *ucet-hosts*) (setq packages (append packages (copy-sequence (get host 'depot-packages))))) (setq packages (sort packages '(lambda (x y) (string-lessp x y)))) (while packages (if (not (member (car packages) uniqs)) (setq uniqs (cons (car packages) uniqs))) (setq packages (cdr packages))) (reverse uniqs))) (defun depot-locate-all-packages () "set the depot-packages property for all hosts at ucet.ufl.edu. The depot-packages property is a list of strings -- package names such as ``www'' -- that exist as subdirectories of /exp/depot and are ready to export to our net. Hosts are simply the symbols whose print names are the local names of hosts on our net." ;; If you want to go out and list them all, this is the way to do it. ;; (dolist (host *ucet-hosts*) ;; (put host 'depot-packages (depot-list-host-packages host))))) (put 'melies 'depot-packages '()) (put 'barthes 'depot-packages '()) (put 'angelou 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "pine" "src" "tcl" "wp" "www" "xapps")) (put 'benjamin 'depot-packages '("apache" "exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'brecht 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "tmp" "wp" "www" "xapps")) (put 'gibson 'depot-packages '("backups" "exmh" "majordomo" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'godard 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "netadm" "pine" "tcl" "tknews" "wp" "www" "xapps")) (put 'haraway 'depot-packages '("Java" "exmh" "mf" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'hooks 'depot-packages '("emacs" "exmh" "ghost" "mf" "mh" "mime" "moo" "ncd" "pine" "tcl" "tex" "wais" "wp" "www" "xapps" "xdev" "xemacs")) (put 'jarry 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'keaton 'depot-packages '("acrobat" "adm" "apache" "exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'ronell 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'stein 'depot-packages '("exmh" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) (put 'vertov 'depot-packages '("apache" "exmh" "geomview" "images" "imaging" "ispell" "mh" "mime" "moo" "ncd" "pine" "tcl" "wp" "www" "xapps")) ) ; (put 'gibson 'depot-packages '("backups" "exmh" "images" "majordomo" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'angelou 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'benjamin 'depot-packages '("acrobat" "adm" "apache" "emacs" "exmh" "ghost" "imaging" "mh" "mime" "moo" "netadm" "pine" "src" "tcl" "tknews" "wais" "wp" "www" "www.old" "xapps" "xdev" "xemacs")) ; (put 'brecht 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "tmp" "wp" "www" "xapps")) ; (put 'godard 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'hooks 'depot-packages '("exmh" "mf" "mh" "mime" "moo" "pine" "tcl" "tex" "wp" "www" "xapps")) ; (put 'jarry 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'keaton 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'ronell 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'stein 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'haraway 'depot-packages '("exmh" "mh" "mime" "moo" "pine" "tcl" "wp" "www" "xapps")) ; (put 'vertov 'depot-packages '("apache" "exmh" "geomview" "ispell" "mh" "mime" "moo" "pine" "share" "tcl" "wp" "www" "xapps")) ; (put 'melies 'depot-packages '()) ; ; ) ;;; Previously seen contents used in depot-locate-all-packages: ; For old 3.2.5 system ; ; (put 'barthes 'depot-packages '("moo" "pine" "tcl")) ; (put 'godard 'depot-packages '("geomview" "imaging" "mf" "moo" "pine" "tar" "tex" "webdev" "wp" "www" "xdev")) ; (put 'haraway 'depot-packages '("emacs" "exmh" "ghost" "mh" "moo" "pine" "src" "tcl" "tknews" "wp" "www" "xapps")) ; (put 'hooks 'depot-packages '("exmh" "info" "mh" "moo" "pine" "tcl" "wp" "xapps")) ; (put 'jarry 'depot-packages '("exmh" "f2c" "khoros" "mh" "moo" "pine" "xemacs")) ; (put 'melies 'depot-packages '("moo" "pine")) ; (put 'ronell 'depot-packages '("emacs" "exmh" "ghost" "images" "imaging" "mh" "moo" "pine" "tcl" "tknews" "wp" "www" "xapps" "xdev")) ; (put 'trinh 'depot-packages '("moo" "pine")) ; ;; We'd like a way to do the above by hand, as it were, when we are ;; are really moving stuff around. Here is what the above function ;; establishes as of Tue Jun 20 1995. ;; (put 'angelou 'depot-packages '("emacs" "ghost" "tcl" "xapps")) ;; (put 'barthes 'depot-packages '("xdev")) ;; (put 'benjamin 'depot-packages nil) ;; (put 'brecht 'depot-packages '("phoenix")) ;; (put 'gibson 'depot-packages '("backups" "exmh" "ispell" "majordomo" "mh" "mm" "moo" "pine" "tknews" "wp")) ;; (put 'godard 'depot-packages '("imaging")) ;; (put 'haraway 'depot-packages '("emacs" "exmh" "ghost" "mh" "moo" "pine" "src" "tcl" "tknews" "wp" "www" "xapps")) ;; (put 'hooks 'depot-packages '("info")) ;; (put 'jarry 'depot-packages nil) ;; (put 'keaton 'depot-packages '("x11r6")) ;; (put 'melies 'depot-packages nil) ;; (put 'ronell 'depot-packages '("emacs" "exmh" "ghost" "images" "imaging" "mh" "moo" "pine" "tcl" "tknews" "wp" "www" "xapps" "xdev")) ;; (put 'stein 'depot-packages '("gcc-2.6.3")) ;; (put 'trinh 'depot-packages nil) ;; (put 'vertov 'depot-packages '("auis" "gnu" "hdf" "khoros" "netadm" "tcl" "wais" "www" "xemacs")) ;;; ;;; AMD ;;; (defun depot-amd-entry (host package) "Make a string that is a valid amd map entry, for PACKAGE on HOST." (let ((providers nil) (entry "")) (setq providers (delete nil (mapcar '(lambda (h) (when (member package (get h 'depot-packages)) h)) (depot-nearest-hosts host)))) (cond ((null providers) (error "amd-map-for-package: no /exp/depot providers for package %s" package)) ;; Check if it is a local link ((eq host (car providers)) (format "%s type:=link;fs:=/exp/depot/%s\n" package package)) (t (let ((options (or (cdr (assoc package *depot-package-options-alist*)) *depot-default-package-options*)) (nfs-defaults "type:=nfs;fs:=${autodir}/${rhost}/depot/${/key};rfs:=/exp/depot/${/key}") (delay 0)) (setq entry (concat package " " options (format " rhost:=%s;%s" (car providers) nfs-defaults)) providers (cdr providers) delay 0) (dolist (provider providers) (setq delay (+ delay 2)) (setq entry (concat entry (format " rhost:=%s;delay:=%d;%s" provider delay nfs-defaults)))) (concat entry "\n")))))) (defun depot-amd-map (host) "return for HOST a string that gives a customized amd /depot map." (let ((packages (depot-packages)) (string *amd-standard-header*)) (dolist (package packages) (setq string (concat string (depot-amd-entry host package)))) string)) ;;; ;;; RDIST ;;; ;;; We use (flatten *ucet-topology*) to find the canonical ;;; rdist order. It would be nice to produce a graph showing ;;; the package distribution.... (defun depot-rdist (host) (let ((our-packages nil) (package-providers nil) (string "") (packages (depot-packages)) (canonical-order (flatten *ucet-topology*))) ;; find out what packages we keep around. (dolist (package packages) (if (member package (get host 'depot-packages)) (setq our-packages (cons package our-packages)))) ;; for all the packages, find what hosts provide that package, with ;; hosts in canonical order. If this host is first on the list, we ;; are the rdist master. We rdist to everyone else on the list. (dolist (package our-packages) (setq package-providers (mapcar '(lambda (h) (when (member package (get h 'depot-packages)) h)) canonical-order)) (setq package-providers (delete nil package-providers)) (if (and (eq host (car package-providers)) (> (length package-providers) 1)) (setq string (concat (format " (/exp/depot/%s) -> %S \n\tinstall -R -y ;\n\n" package (cdr package-providers)) string)))) string)) ;;; ;;; RHOSTS ;;; ;;; Take care of the permissions required by the rdist files above. ;;; (defvar *depot-rhosts-entries-initialized* nil) (defun depot-initialize-rhosts-entries () (unless *depot-rhosts-entries-initialized* (setq *depot-rhosts-entries-initialized* t) (let ((our-packages nil) (package-providers nil) (packages (depot-packages)) (canonical-order (flatten *ucet-topology*))) (dolist (host *ucet-hosts*) ;; boiler plate: all hosts must have these, since gibson is the one ;; machine from which we want to be able to rdist elements of /usr. (put host 'rhosts-entries (cons 'gibson (get host 'rhosts-entries))) ;; find out what packages we keep around. (dolist (package packages) (if (member package (get host 'depot-packages)) (setq our-packages (cons package our-packages)))) ;; for all the packages, find what hosts provide that package, with ;; hosts in canonical order. If this host is first on the list, we ;; are the rdist master. We rdist to everyone else on the list. (dolist (package our-packages) (setq package-providers (mapcar '(lambda (h) (when (member package (get h 'depot-packages)) h)) canonical-order)) (setq package-providers (delete nil package-providers)) (if (and (eq host (car package-providers)) (> (length package-providers) 1)) (dolist (slaves (cdr package-providers)) (put slaves 'rhosts-entries (cons host (get slaves 'rhosts-entries))))))) (dolist (host *ucet-hosts*) (let ((rhosts-entries nil) (uniqs nil)) (setq rhosts-entries (sort (get host 'rhosts-entries) '(lambda (x y) (string-lessp x y)))) (while rhosts-entries (if (not (member (car rhosts-entries) uniqs)) (setq uniqs (cons (car rhosts-entries) uniqs))) (setq rhosts-entries (cdr rhosts-entries))) (put host 'rhosts-entries (reverse uniqs))))))) (defun depot-rhosts (host) "Returns a string that is an appropriate /.rhosts file for HOST, allowing remote access to machines that will have to rdist this host a master copy of /depot package." (depot-initialize-rhosts-entries) (let ((result (concat "# .rhosts file automatically generated by depot.el\n" "# Changes to this file will be overwritten.\n" "localhost root\n"))) (dolist (slave (get host 'rhosts-entries)) (setq result (concat result (format "%s.ucet.ufl.edu root\n" slave)))) result)) ;;; BACKUPS ;;; ;;; We want to make a list of elements of the form "host:/exp/depot/package" ;;; for doing automated backups. We use the rdist master for each package ;;; as the host. Each package is included once. ;;; (defun depot-backup-entries () (let ((hosts nil) (entries nil) (packages (depot-packages)) (canonical-order (flatten *ucet-topology*))) (dolist (package packages) (setq hosts canonical-order) (while (and hosts (not (member package (get (car hosts) 'depot-packages)))) (setq hosts (cdr hosts))) (if (not hosts) (error "make-backup-entry: no host for package %s" package) (setq entries (cons (format "%s:/exp/depot/%s" (car hosts) package) entries)))) (reverse entries))) ;;; ;;; EXPORTS file ;;; This is probably not worth doing. ;;; ;;; DEPOT FILES ;;; ;;; Typically we will only want to go through the setup procedure once, so ;;; we collect all the files in the current directory under names ;;; rhosts.hostname Distfile-depot.hostname and amd.depot.hostname ;;; Whew! Guess that takes care of them all. Some shell script needs to ;;; actually copy them out to the appropriate machines. ;;; (defun depot-files () (save-excursion (dolist (host *ucet-hosts*) (let ((string "") (buff (get-buffer-create " *depot* "))) (set-buffer buff) (delete-region (point-min) (point-max)) (insert (depot-rhosts host)) (write-region (point-min) (point-max) (format "rhosts.%s" host)) (delete-region (point-min) (point-max)) (insert (depot-amd-map host)) (write-region (point-min) (point-max) (format "amd.depot.%s" host)) (unless (string-equal "" (setq string (depot-rdist host))) (delete-region (point-min) (point-max)) (insert string) (write-region (point-min) (point-max) (format "Distfile-depot.%s" host))))))) (setq *ucet-hosts* (sort (flatten *ucet-topology*) '(lambda (x y) (string-lessp x y))))