gnu-emacs-sources
[Top][All Lists]
Advanced

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

dsa-fn.el v. 0.1


From: D Goel
Subject: dsa-fn.el v. 0.1
Date: Sun, 16 Jan 2005 14:23:12 -0500
User-agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.2 (gnu/linux)

 dsa-fn.el --- Check a hybrid system against Debian Security Advisories

New from 0.0 to 0.1: 
===================

 Number of minor bugfixes.  Slightly smarter logic.  dsa-fn.el
 divides all packages into upto 6 categories and reports accordingly.
 The accompanying script file dsa is same as before, and so not
 reattached.


-----------------------------------------------------

INTRODUCTION:
============
Included below: dsa-fn.el.  Also, Attached shell-script: dsa.

This is my first attempt to try out some emacs shell-scripting. Though
meant to be called as a script from bash prompt (that action needs
/usr/local/bin/emacscvs), this package does work within Emacs too (and
that only needs Emacs 21).

dsa-fn.el looks at Debian Security Advisories and tries to prescribe
the minimal prescription needed to make your (possibly hybrid) machine
compliant with them.  If you maintain your system at testing, you
don't want to upgrade everything to sid, yet to want to upgrade the
packages from DSAs to sid.  When you maintain a hybrid system
comprising stable, woody and sid, this equation becomes more
complex. Examining each DSA on all your machines is time-consuming,
right?  You probably want all your stable packages to be uptodate, but
you want any nonstable DSA'ed packages to be brought to sid.
dsa-fn.el prescribes recommendations to achieve that.



Type M-x dsa-quick-start for quickstart.

This package will work only if the distributions are called stable,
testing and unstable (not sid or woody, etc, in your sources.list),
and uses shell-commands a lot.  This package also needs shs.el, posted
here separately.




-----------------------------------------------------
The latest version can be had from
http://gnufans.net/~deego/pub/emacspub/lisp-mine/shs/dev/ .
;;;---------------- CUT HERE -------------------------------

;;; dsa-fn.el --- Check a hybrid system against Debian Security Advisories
;; Time-stamp: <2005-01-16 14:22:21 deego>
;; Copyright (C) 2005 D. Goel
;; Emacs Lisp Archive entry
;; Filename: dsa-fn.el
;; Package: dsa
;; Author: D. Goel <address@hidden>
;; Keywords:
;; Version:  0.1
;; URL: http://gnufans.net/~deego
;; For latest version:
;; Copyright (C) 2005 D. Goel


 
;; This file is NOT (yet) part of GNU Emacs.
 
;; This 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 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
 

;; provide basic setup for emacs scripting. To the beginning of all
;; emacs shell-scripts, don't forget to add (add-to-list 'load-path
;; directory) and (require 'shs).  Use shs as a convenient way to call
;; shell-commands from the script.

;; shs.el has been renamed to shs.el since there exists another shs.el
;; -- shs stands for SHell-Script.


(defconst dsa-fn-home-page
  "http://gnufans.net/~deego/pub/emacspub/lisp-mine/shs/dev/";)



;; Quick start:




(defconst dsa-quick-start
  " If you want to use dsa-fn from a running emacs, just drop
dsa-fn.el package and shs.el somewhere in your load-path (best if that
location is also in bash path, see below).  Add (require 'dsa-fn) in
.emacs.  

Then, type C-u N M-x dsa -- that examines the last N DSAs for this
year.  Use (dsa N YEAR) to exmamine the last N DSAs for any YEAR.
Type (dsa 0 2005 622 629) to examine DSAs 622--629.  It will work,
though it is really optimized for running as a shell-script.

To install it for use as a shell-script too, follow the shs.el
instructions: Drop this file dsa-fn.el, the attached script dsa and
shs.el somewhere ~/location, this location should be common to your
emacs' loadpath and bash's path. Also Create a ~/.emacs.script with
this line:

 (add-to-list 'load-path \"/in/your/bash/path\")

Now, typing dsa from bash will examine the last 5 DSA's, typing dsa 0
2005, will examine all dsa's for 2005, and so on (same syntax as
emacs' dsa above).


"
)
(defun dsa-quick-start ()
  "Provides electric help from variable `dsa-quick-start'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dsa-quick-start) nil) "*doc*"))

;;; Introduction:
;; Stuff that gets posted to gnu.emacs.sources
;; as introduction

(defconst dsa-introduction
  "Included below: dsa-fn.el.  Also, Attached shell-script: dsa.

This is my first attempt to try out some emacs shell-scripting. Though
meant to be called as a script from bash prompt (that action needs
/usr/local/bin/emacscvs), this package does work within Emacs too (and
that only needs Emacs 21).

dsa-fn.el looks at Debian Security Advisories and tries to prescribe
the minimal prescription needed to make your (possibly hybrid) machine
compliant with them.  If you maintain your system at testing, you
don't want to upgrade everything to sid, yet to want to upgrade the
packages from DSAs to sid.  When you maintain a hybrid system
comprising stable, woody and sid, this equation becomes more
complex. Examining each DSA on all your machines is time-consuming,
right?  You probably want all your stable packages to be uptodate, but
you want any nonstable DSA'ed packages to be brought to sid.
dsa-fn.el prescribes recommendations to achieve that.



Type M-x dsa-quick-start for quickstart.

This package will work only if the distributions are called stable,
testing and unstable (not sid or woody, etc, in your sources.list),
and uses shell-commands a lot.  This package also needs shs.el, posted
here separately.



"
)
(defconst dsa-fn-introduction dsa-introduction)

;;;###autoload
(defun dsa-introduction ()
  "Provides electric help from variable `dsa-introduction'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dsa-introduction) nil) "*doc*"))

;;; Commentary:
(defconst dsa-commentary
  "Help..."
)

(defun dsa-commentary ()
  "Provides electric help from variable `dsa-commentary'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dsa-commentary) nil) "*doc*"))



;;; History:

;;; Bugs:

;;; New features:
(defconst dsa-fn-new-features
  "New from 0.0 to 0.1: 
===================

 Number of minor bugfixes.  Slightly smarter logic.  dsaq-fn.el
 divides all packages into upto 6 categories and reports accordingly.
 The accompanying script file dsa is same as before, and so not
 reattached.

"
)

(defun dsa-fn-new-features ()
  "Provides electric help from variable `dsa-new-features'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dsa-new-features) nil) "*doc*"))

;;; TO DO:
(defconst dsa-todo
  "Help..."
)


(defconst dsa-version "0.1")

(defconst dsa-fn-version dsa-version)
;;(setq dsa-fn-version dsa-version)

(defun dsa-version (&optional arg)
   "Display dsa's version string.
With prefix ARG, insert version string into current buffer at point."
  (interactive "P")
  (if arg
      (insert (message "dsa version %s" dsa-version))
    (message "dsa version %s" dsa-version)))



(defgroup dsa nil
  "The group dsa."
  :group 'applications)
(defcustom dsa-before-load-hook nil
  "Hook to run before loading dsa."
  :group 'dsa)
(defcustom dsa-after-load-hook nil
  "Hook to run after loading dsa."
  :group 'dsa)
(run-hooks 'dsa-before-load-hook)

(defcustom dsa-verbosity 0
  "How verbose to be.
Once you are experienced with this lib, 0 is the recommended
value.  Values between -90 to +90 are recommended for general use and
the rest for debugging."
  :type 'integer
  :group 'dsa)
(defcustom dsa-interactivity 0
  "How interactive to be.
Once you are experienced with this lib, 0 is the recommended
value.  Values between -90 and +90 are recommended for general use and
the rest for debugging."
  :type 'integer
  :group 'dsa)
(defcustom dsa-y-or-n-p-function 'dsa-y-or-n-p
  "Function to use for interactivity-dependent  `y-or-n-p'.
Format same as that of `dsa-y-or-n-p'."
  :type 'function
  :group 'dsa)
(defcustom dsa-n-or-y-p-function 'dsa-n-or-y-p
  "Function to use for interactivity-dependent `n-or-y-p'.
Format same as that of `dsa-n-or-y-p'."
  :type 'function
  :group 'dsa)
(defun dsa-message (points &rest args)
  "Signal message, depending on POINTS anddsa-verbosity.
ARGS are passed to `message'."
  (unless (minusp (+ points dsa-verbosity))
    (apply #'message args)))
(defun dsa-y-or-n-p (add prompt)
  "Query or assume t, based on `dsa-interactivity'.
ADD is added to `dsa-interactivity' to decide whether
to query using PROMPT, or just return t."
  (if (minusp (+ add dsa-interactivity))
        t
      (funcall 'y-or-n-p prompt)))
(defun dsa-n-or-y-p (add prompt)
  "Query or assume t, based on `dsa-interactivity'.
ADD is added to `dsa-interactivity' to decide whether
to query using PROMPT, or just return t."
  (if (minusp (+ add dsa-interactivity))
        nil
      (funcall 'y-or-n-p prompt)))

;; Real code:

(require 'cl)
(require 'shs)


(defun dsa-version-sign1 (ss1 ss2)
  (let* ((s1 (car ss1))
         (s2 (car ss2))
         (n1 (and s1 (string-to-number s1)))
         (n2 (and s2 (string-to-number s2))))
    (dsa-debug-msg 245 ss1 s1 n1 ss2 s2 n2)
    (cond
     ((null s1) 
      (if (null s2) 0 -1))
     ((null s2) 1)
     ((not (and (numberp n1) (numberp n2)))
      (error 
       "n1: %S and n2: %S are not numbers when comparing %S and %S"
       n1 n2 ss1 ss2))
     ((> n1 n2) 
      (dsa-debug-msg 253 "n1" n1 "n2" n2 1) 
      (if (= n1 dsa-inf) 2 1))
     ((< n1 n2) (if (= n2 dsa-inf) -2 -1))
     ((= n1 n2) (dsa-version-sign1 (cdr ss1) (cdr ss2))))))

         
(defun dsa-version-sign (v1 v2)
  "Given 2 package versions as strings, tell if v1-v2 is positive,
  negative or 0."
  ;; They can be 'unknown!  
  (when (numberp v1) (setq v1 (format "%s" v1)))
  (when (numberp v2) (setq v2 (format "%s" v2)))
  (when (not (stringp v1)) (error "Unkwnown v1"))
  (when (not (stringp v2)) (error "Unkwnown v2"))
  (let (ans)
    (setq 
     ans
     (cond
      ((string= v1 v2) 0)
      (t
       (let (
             ;;(ss1 (remove "" (split-string v1 "[ \f\t\n\r\v.-]+")))
             (ss1 (remove "" (split-string v1 "[^0-9]+")))
             (ss2 (remove "" (split-string v2 "[^0-9]+")))
             )
         (dsa-version-sign1 ss1 ss2)))))
    (dsa-debug-msg 271 "v1:" v1 "v2" v2 ans)
    ans))





(defun dsa-version-lessp (v1 v2)
  (< (dsa-version-sign v1 v2) 0))
(defun dsa-version-greaterp (v1 v2)
  (> (dsa-version-sign v1 v2) 0))

(defun dsa-version= (v1 v2)
  (= (dsa-version-sign v1 v2) 0 ))




(defun dsa-pkgversion (pkg)
  "Given a pkg string, return its installed version. If no luck,
return nil.  Also returns the 2 categories that the package belongs
to. "
  (dsa-debug-msg 84 pkg)
  (if (and pkg (not (member pkg  '(""  " "))))
      (let*
          ((ver (ignore-errors 
                  (shs-shell 
                   (concat "apt-show-versions -p " pkg))))
           (verstrs (split-string ver "[ \f\t\n\r\v/]+"))
           ls1)
        (when (stringp ver)
          (setq ver (replace-regexp-in-string "\n" " " ver)))
        (shsm "%s: %s" pkg ver)
        (setq ls1 
              (cond
               ((null ver) 'error)
               ;; older apt-show-versions
               ((equal  "" ver) nil)
               ;; newer apt-show-versions
               ((string-match "not installed" ver) nil)
               ((string-match "uptodate" ver)
                (list (fourth verstrs) (second verstrs)(third
                                                        verstrs)))
               ((string-match "upgradeable from" ver)
                (list (fifth verstrs) (second verstrs) (third
                                                        verstrs)))
               (t 'error)))
        ;; This should not be done here.  Rather, in dsa-examine.
        ;;(when (equal (second ls1) "testing")
        ;;(setf (second ls1) "unstable")
        ;;(setf (third ls1) "upgradeable"))
        ls1)
    'error))








(defun dsa-versions (pkg)
  "Given a pkg string, return a list of candidate, stable, testing and
sid versions.  Don't know how to get it, so left blank. "
  nil)
    
    
(defvar dsa-inf 99999999 "Infinity")

(defun dsa-parse-advisory (dsa)
  "Given a string containing the DSA, try to parse the english to see
  what's needed for sid. If we cannot parse, we return nil.  If the
  parsing says Already fixed, we return a string \"0\". If the parsing
  says \"will be fixed soon\", we return a string \"99999999\".  Else,
  we return a string containing a version number. "
  (cond
   ;; multiple versions: bail out
   ((string-match 
     "unstable.* fixed.*version.*\\(,\\|and\\).*" dsa)
    (shsm "Multiple versions, will bail out. ")
    nil)

   ((string-match 
     "For the \\(?:current \\)?unstable distribution (sid).*fixed soon" dsa)
    (format "%s" dsa-inf))
   ((string-match 
     "For the \\(?:current \\)?unstable distribution (sid).*fixed in 
version\\(.*\\)\n" dsa)
     (match-string 1 dsa))
   ((string-match 
     "For the \\(?:current \\)?unstable distribution 
(sid).*already.?.?.?.?.?.?fixed"
     dsa)
    "0")

   ((string-match 
    "The unstable distribution (sid) does not contain e\\(?:this\\|these\\) 
packages?\\."
    dsa) "0")

   ((string-match 
     "unstable.*this problem was not present"
     dsa)
    "0")


   ((string-match 
     "unstable.*not affected"
     dsa)
    "0")

   ((string-match 
     "unstable.*unaffected"
     dsa)
    "0")


   (t 'unknown)))


    
(defun dsa-parse-advisory-stable (dsa)
  "Given a string containing the DSA, try to parse the english to see
  what's needed for sid. If we cannot parse, we return nil.  If the
  parsing says Already fixed, we return a string \"0\". If the parsing
  says \"will be fixed soon\", we return a string \"99999999\".  Else,
  we return a string containing a version number. "
  (cond
   ;; multiple versions: bail out
   ((string-match 
     "[^n]stable.* fixed.*version.*\\(,\\|and\\).*" dsa)
    nil)

   ((string-match 
     "For the \\(?:current \\)?stable distribution.*fixed soon" dsa)
    "99999999")
   ((string-match 
     "For the \\(?:current \\)?stable distribution.*fixed in version\\(.*\\)\n" 
dsa)
     (match-string 1 dsa))

   (t 'unknown)))
   
  
(defvar dsa-versions nil)

(defun dsa-versions-all-update ()
  (setq dsa-versions
        (shs-shell "apt-show-versions")))

(defun dsa-versions-all-update-maybe  ()
  (if (null dsa-versions)
      (dsa-versions-all-update)))

(defvar dsa-debug-ddstr)

(defvar dsa-debug-dscstr)


(defun dsa-url (dnum yr)
  (concat "http://www.debian.org/security/"; yr
          "/dsa-" (format "%s" dnum)))

(defun dsa-one-advisory (dnum yr)
  "Return a list of errorcode, sidlist futurelist neverlist hecklist 
optionallist stablelist"
  (let (sidlist futurelist neverlist hecklist optionallist stablelist
                needed stableneeded dpgstr dpgstrs dscstrs dpg 
                (errcode  nil)
                )
    (shsm 
     "===== DSA number: %s ===================================================="
     dnum)
    (setq dpg (dsa-url dnum yr))
          

    (shsm "%s" dpg)
    ;; turn off wrapping: 
    (setq dpgstr (shs-shell (concat "w3m -cols 1000 -dump "
                                    dpg)))

    (setq needed (dsa-parse-advisory dpgstr))
    (setq stableneeded (dsa-parse-advisory-stable dpgstr))
    (setq dpgstrs (split-string dpgstr))
    (setq dscstrs (remove-if-not 
                   (lambda (arg) (string-match "http.*dsc\\b" arg))
                   dpgstrs))
    (unless dscstrs (setq errcode t))
    (loop for dscstr in dscstrs do
          (let ((ddstr 
                 (shs-shell
                  (concat "w3m -cols 1000 -dump "
                        dscstr)))
                binarystr packages)
            (setq binarystr 
                  (progn
                    (string-match "Binary:\\(.*\\)\n" ddstr)
                    (match-string 1 ddstr)))
            (unless binarystr (setq errcode t))
            (setq dsa-debug-ddstr ddstr)
            (setq dsa-debug-dscstr dscstr)
            (when binarystr
              (setq packages 
                    (remove ""
                            (split-string binarystr 
                                          "[ \n\t,]+"))))
            (unless packages (setq errcode t))
            (dsa-debug-msg 189 "Packages: " packages)
            (loop for pkg in packages do 
                  (let ((retcode (dsa-examine pkg needed stableneeded)))
                    (if (> retcode -1)
                        (add-to-list 
                         (case retcode
                           (0 'sidlist)
                           (1 'futurelist)
                           (2 'neverlist)
                           (3 'hecklist)
                           (4 'optionallist)
                           (5 'stablelist)
                           (t (error "bad retcode")))
                         (list pkg dpg)))))))
    (when errcode 
      (shsm "TROUBLE PARSING %s, no dsc page?" dpg))
    (dsa-debug-msg-lists sidlist futurelist neverlist hecklist optionallist 
stablelist)
    (list errcode sidlist futurelist neverlist hecklist optionallist
          stablelist)))

(defvar dsa-debug-level 0)
(defun dsa-debug-msg-lists (sidlist futurelist neverlist hecklist
                                    optionallist stablelist)
  (when (>= dsa-debug-level 10)
    (shsm "Upgrade from sid, sidlist: %S" sidlist)
    (shsm "Upgrade not available, futurelist: %S" futurelist)
    (shsm "Package ok, but I am unsure, neverlist : %S" neverlist)
    (shsm "I am totally confused, hecklist: %S" hecklist)
    (shsm "Package DSA-compliant, but sid upgrade available upgrade from sid, 
optionallist: %S" optionallist)
    (shsm "Upgrade from stable,stablelist: %S" stablelist)))

(defsubst dsa-debug-msg (&rest args)
  (when (>= dsa-debug-level 30)
    (shsm (format "%S" args))
    (sleep-for .1)))


(defvar dsa-num-default 2)


(defun dsa-prelims ()
  ;; bail out if some commands not installed. 
  (unless (ignore-errors (shs-shell "which apt-show-versions"))
    (error "Please install apt-show-versions and rerun this script"))
  (unless (ignore-errors (shs-shell "which w3m"))
    (error "Please install w3m and rerun this script"))
  )



;;;###autoload
(defun dsa-fn (&optional num yr  dmin dmax overridep)
  "Provide secrity advices for a hybrid debian system.

This function tries to prescribe the minimum prescription to make
your (possibly hybrid) debian system compliant with DSAs: the Debian
Security advisories.  It tries to make
suggestions by parsing ALL security advisories in a given year. 

NUM is the number of security advisories to examine, starting with the
latest one available.  When 0 or more than the number of advisories,
we examine ALL advisories for the year.

YR is the year.

When DMIN and DMAX are present, NUM is ignored.  DMIN and DMAX are
numbers specify the range of codes (like DSA-641 -- DSA-639) of the
advisories to examine for the year.

If DMIN is present, but not DMAX, then the single advisory specified
by DMIN is examined. 

Whatever numbers you supply, we shall try to eliminate nonexistent
advisories before proceeding unless OVERRIDEP is t.
"
  (interactive "p")
  (dsa-prelims)
  (when (stringp num)
    (setq num (ignore-errors (string-to-number num))))

  (when (stringp yr)
    (setq yr (ignore-errors (string-to-number yr))))


  (when (stringp dmin)
    (setq dmin (ignore-errors (string-to-number dmin))))

  (when (stringp dmax)
    (setq dmax (ignore-errors (string-to-number dmax))))

  (unless num (setq num dsa-num-default))
  
  (dsa-debug-msg 17 (format "%S %S %S %S" num yr dmin dmax))
  
  (when (equal num 0) (setq num 9999999))

  (shs-start)
  (switch-to-buffer shs-buffer)
  ;;(shs-shell "clear")
  ;;(shsm "Getting versions..")
         
  ;; Make it 2005..
  (cond
   ((numberp yr) (setq yr (format "%s" yr)))
   (t (setq yr (format-time-string "%Y"))))
  (dsa-debug-msg 30 yr)
  ;;(sleep-for 2)

  (let* (allnewlists errcode errcodes 
         ;; packages to be upgraded to sid.. Each such package is a
         ;; list of packages as well as the corresponding DSA page. 
         (sidlist nil)   sids
         (stablelist nil)        stables
         ;; packages for future
         (futurelist nil) futures
         ;; fix at infinity.
         (neverlist nil) nevers
         ;; no idea what the heck happened to this package..
         (hecklist nil) hecks
         (optionallist nil) options
         ;;(dsa-versions (shs-shell "apt-show-versions"))
         dpg dpgstr
         ddscs
         ;; DSA page. 
         (dsapg (shs-shell 
                 (concat
                  "w3m -dump http://www.nl.debian.org/security/"; 
                  yr)))
         (strs (split-string dsapg))
         (strs1 (delete-if-not (lambda (arg) (string-match "^DSA-"
                                                           arg))
                               strs))
         (nums (mapcar (lambda (ss) 
                         (read (replace-regexp-in-string "^DSA-"
                                                         "" ss)))
                       strs1))
         (offnummin (and nums (apply 'min nums)))
         (offnummax (and nums (apply 'max nums)))
         (nummax offnummax)
         (nummin offnummin)
         needed stableneeded dpkstrs dscstrs
         )
    (shsm "The requested year %s has DSAs ranging from %s--%s" yr nummin
          nummax)

    (when (null nums)
      (error "**** NO ADVISORIES FOUND FOR THE YEAR %s" yr))

    (when (and (numberp dmin)
               (not (numberp dmax)))
      (setq dmax dmin))

    (cond
     ((and (numberp dmin)
           (numberp dmax))
      (setq nummin dmin)
      (setq nummax dmax))
     (t nil))
    
    (dsa-debug-msg 284 nummin nummax num)
    (shsm "")

    (unless overridep
      (if (not dmin)
          (if (> (+ nummax (- 0 nummin) 1) num)
              (setq nummin (+ nummax (- 0 num) 1)))))
    (unless overridep
      (if (> nummax offnummax)
          (setq nummax offnummax)))

    (unless overridep
      (if (< nummin offnummin)
          (setq nummin offnummin)))

    
    (shsm "We shall examine DSAs for %s ranging from %s--%s" yr nummin
          nummax)
    (sleep-for .2)
    (dsa-debug-msg 284)
    (loop for dnum downfrom nummax to nummin do
          
          (dsa-debug-msg 286)
          
          (setq allnewlists 
                (dsa-one-advisory dnum yr))
          (setq errcode (pop allnewlists))
          (when errcode (add-to-list 'errcodes dnum))
          (setq sidlist (append (nth 0 allnewlists) sidlist))
          (setq futurelist (append (nth 1 allnewlists) futurelist))
          (setq neverlist (append (nth 2 allnewlists) neverlist))
          (setq hecklist (append (nth 3 allnewlists) hecklist))
          (setq optionallist (append (nth 4 allnewlists) optionallist))
          (setq stablelist (append (nth 5 allnewlists) stablelist)))
    
    

    (dsa-debug-msg 300)
    
    
    (setq sids (remove-duplicates (mapcar 'car sidlist)))
    (setq futures (remove-duplicates (mapcar 'car futurelist)))
    (setq options (remove-duplicates (mapcar 'car optionallist)))
    (setq nevers (remove-duplicates (mapcar 'car neverlist)))
    (setq hecks (remove-duplicates (mapcar 'car hecklist)))
    (setq stables (remove-duplicates (mapcar 'car stablelist)))

    (shsm 
     
"===============================================================================")

    (shsm 
     
"===============================================================================")

    (shsm
     "==================||  FINAL REPORT  
||=========================================")
    (shsm
     "==================||  FINAL REPORT  
||=========================================")
    (shsm 
     
"===============================================================================")
    (shsm 
     
"===============================================================================")
    (let ((any nil))
        (shsm "")
        (shsm "")
        (shsm "")
        (shsm "")
        (shsm "")


        (shsm "")
      (when errcodes

        (shsm "I HAD TROUBLE PARSING THESE DSAs, perhaps because of missing 
.dsc pages.  PLEASE EXAMINE THEM YOURSELF!!!! :") 
        (shsm (mapconcat 
               (lambda (arg) (dsa-url arg yr))
               errcodes "\n"))
        (setq any t))




      (when nevers
        (setq any t)
        (shsm
         
"*******************************************************************************")

        (shsm "DSA says \"Will be fixed soon\", so I have no idea
        about these packages.  You should perhaps upgrade these
        nonstable installs to the latest sid versions in any
        case: ")
        (shsm "\n%s %s"
              "apt-get -u -t unstable install "
              (mapconcat 'identity
                         nevers " ")))


      (when hecklist
        (setq any t)
        (shsm 
"*******************************************************************************")
        (shsm "")
        (shsm "I HAVE NO CLUE WHAT WENT ON WITH THESE PACKAGES. PLEASE CHECK 
YOURSELF!!: ")
        (shsm (format "%s" (mapconcat 'identity 
                                      (mapcar (lambda (a) 
                                                (format "%s:\n%s"
                                             (first a) (second a)))
                                              hecklist)
                                      "\n"))))

      (when futurelist
        (setq any t)
        (shsm
         
"*******************************************************************************")
        (shsm "YOU ARE RUNNING THE LATEST (SID) VERSIONS OF THESE PACKAGES, ")
        (shsm "BUT THESE ARE STILL VULNERABLE -- ")
        (shsm "THESE PACKAGES APPEAR TO HAVE NO AVAILABLE FIXES YET! : ")
        
        (shsm (format "%s" (mapconcat 'identity 
                                      (mapcar (lambda (a) 
                                                (format "%s\n  %s"
                                                        (first a) (second a)))
                                              futurelist)
                                      "\n"))))
    


      (when options
        (setq any t)
        (shsm
         
"*******************************************************************************")

        (shsm "Your nonstable install for these packages may
not be the latest, but *does* satisfy the required version for
one or more checked DSAs.  If you want to upgrade to the latest
version anyway \(NOT NEEDED), type:")
        (shsm "\n%s %s"
              "apt-get -u -t unstable install "
              (mapconcat 'identity
                         options " ")))


      (when stables
        (setq any t)
        (shsm
         
"*******************************************************************************")
        (shsm "Please DO apt-get upgrade these packages to stable: ")
        (shsm "Pin unstable/testing to negative, and then type\n\n%s %s"
              "apt-get -u -t stable install "
              (mapconcat 'identity
                         stables " "))
        
        (shsm "With pinning done, this might be equivalent to:")
        (shsm "apt-get -u -t stable upgrade"))



      (when sids

        (setq any t)
        
        
        (shsm
         
"*******************************************************************************")
        (shsm "Please DO apt-get upgrade these packages to sid. One or
more DSA needs you to upgrade: ")
        (shsm "Type\n%s %s"
              "apt-get -u -t unstable install "
              (mapconcat 'identity
                         
                        sids " ")))


      (cond 
       (any
        (shsm
         
"*******************************************************************************")
        (shsm "NOTE: Don't forget to run apt-get update before
upgrading as above, or before running this script. After any
upgrading, DO RUN THIS SCRIPT AGAIN to check.  If packages still show
up requiring to be upgraded, the current sid versions don't fix it and
the DSAs are unfixed ATM. Note that some packages may appear in
DUPLICATE lists above, corresponding to different DSAs. ")
        (shsm "\nYour system is otherwise completely DSA-compliant for
the checked Debian Security Advisories."))
       (t (shsm "Your system is fully DSA-compliant for the checked
Debian Security Advisories.")))
      
      (shs-bye))))

;;;###autoload
(defalias 'dsa 'dsa-fn)






(defun dsa-examine (pkg sidneeded stableneeded)
  "Given a package version and a supplied needed version, we look at
   the system and return a code.  The code is -1, 0 1 2 or 3.

 -1 ==> the package is ok.  No upgrades needed.  Either you are at the
      latest stable version on your system, or you are at the latest
      sid version, and needed corresponds to that version.  OR, this
      package is NOT installed. 
         
 0 ==> NEEDS TO BE UPGRADED TO SID VERSION, BUT THAT MIGHT NOT SOLVE
       THE PROBLEM

 1 ==> YOU ARE AT LATEST, AND THIS PACKAGE DOES NOT HAVE A FIX YET

 2 ==> DSA says: WILL BE FIXED... so no idea when fixed, but please upgrade

 3 ==> NO IDEA WHAT THE HECK WENT ON WITH THIS ONE. 

 4 ==> You are fine, said needed version is older than your current version,
       although a newer sid version MAY BE available. 

 5 ==> NEEDS TO BE UPGRADED TO STABLE VERSION. 
"
  (let* (
         code 
         distro
         (vlist (dsa-pkgversion pkg))
         (installed (and (listp vlist) (first vlist)))
         (release (and (listp vlist) (second vlist)))
         (stablep (equal release "stable"))
         (unstablep (member release '("testing" "unstable" "sid")))
         (uptodatep (and (listp vlist) 
                         ;; do not regard testing uptodates as uptodate.
                         (member release '("stable" "unstable" "sid"))
                         (equal (third vlist) "uptodate")))
         ;; comparison to stableneeded
         (cstableneeded (ignore-errors (dsa-version-sign installed 
stableneeded)))
         (csidneeded (ignore-errors (dsa-version-sign installed
                                                      sidneeded)))
         (infp (equal csidneeded -2)))
    
    (dsa-debug-msg 
     (format "DBG: installed: %S release: %S, cstableneeded: %S csidneeded" 
             installed release cstableneeded))
    
    (setq code 
     (cond
      ((equal vlist 'error) 3)
      ((null vlist)
       -1)
      ((and stablep (null cstableneeded)) 3)
      ;; is better than or equal to required, 
      ((and stablep (>= cstableneeded 0)) (list 'stable -1 5))
      ;; needs upgrade
      ((and stablep (< cstableneeded 0)) 5)

      ((and unstablep (null csidneeded)) 3)

      ;; better than or equal to required:
      ((and unstablep (>= csidneeded 0)) (list 'sid -1 4))

      ;; worse than required:
      ((and unstablep (< csidneeded 0)) 
       (if infp
           (list 'sid 1 2)
         (list 'sid 0 1)))

      (t 3)))

     
    ;; We have these possibilities: 
    ;; sid (1 2), (-1  4) (0 1)
    ;; stable: (-1 5) 
    (when (listp code)
      (setq distro (first code) code (cdr code))
      (setq code 
            (case distro
              (stable 
               (cond 
                ;; If there's  a later stable available, you should upgrade no
                ;; matter what.
                ((equal code '(-1 5)) (if (not uptodatep) 5 -1))
                (t 3)))
              (sid
               (cond
                ((equal code '(1 2))
                 (if uptodatep 1 2))
                ((equal code '(-1 4))
                 (if (not uptodatep) 4 -1))
                ((equal code '(0 1))
                 (if uptodatep 1 0))
                (t 3)))
              (t 3))))
    (let ((msgstr 
           (format  
            "%s: installed: %s, stable needed: %s, sid needed: %s (code: %s)"
                    pkg installed stableneeded sidneeded code)))
      (unless (member code '(-1 4))
        (setq msgstr (format ",----\n|%s \n`----"  (upcase msgstr))))
     
      (shsm "%s" msgstr))
    code))



(provide 'dsa-fn)
(provide 'dsa)
(run-hooks 'dsa-after-load-hook)






reply via email to

[Prev in Thread] Current Thread [Next in Thread]