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

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

dsa-fn.el v. 0.0


From: D Goel
Subject: dsa-fn.el v. 0.0
Date: Sat, 15 Jan 2005 21:46:38 -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



INTRODUCTION:
============
File here; 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 if it were a bash shell script (that 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 need.




-----------------------------------------------------
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-15 21:45:58 deego>
;; Copyright (C) 2005 D. Goel
;; Emacs Lisp Archive entry
;; Filename: dsa-fn.el
;; Package: dsa
;; Author: D. Goel <address@hidden>
;; Keywords:
;; Version:  0.0
;; URL: http://gnufans.net/~deego
;; For latest version:
;; Copyright (C) 2005 D. Goel

;;IN PROGRESS.

 
;; 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
  "File here; 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 if it were a bash shell script (that 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 need.



"
)
(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-new-features
  "Help..."
)

(defun dsa-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.0")

(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))))
    (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) 1)
     ((< n1 n2) -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."
  (cond
   ((string= v1 v2) 0)
   (t
    (let (
          (ss1 (split-string v1 "[ \f\t\n\r\v.-]+"))
          (ss2 (split-string v2 "[ \f\t\n\r\v.-]+")))
      (dsa-version-sign1 ss1 ss2)))))



(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/]+")))
        (shsm "%s: %s" pkg ver)
        (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)))
    '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)
    
    
(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)
    "99999999")
   ((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 warnlist hecklist 
optionallist stablelist"
  (let (sidlist futurelist warnlist 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 'warnlist)
                           (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 warnlist hecklist optionallist 
stablelist)
    (list errcode sidlist futurelist warnlist hecklist optionallist
          stablelist)))

(defvar dsa-debug-level 0)
(defun dsa-debug-msg-lists (sidlist futurelist warnlist 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, warnlist : %S" warnlist)
    (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 5)


(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"))
  )



(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
         ;; we think you are ok, but can't quite tell!  
         (warnlist nil) warns
         ;; 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 warnlist (append (nth 2 allnewlists) warnlist))
          (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 warns (remove-duplicates (mapcar 'car warnlist)))
    (setq hecks (remove-duplicates (mapcar 'car hecklist)))
    (setq stables (remove-duplicates (mapcar 'car stablelist)))
    (shsm 
"*******************************************************************************")
    (shsm 
"*******************************************************************************")
    
    (let ((any nil))
        (shsm "")
        (shsm "")
        (shsm "")
        (shsm "")
        (shsm "")
        (shsm
         "******************** FINAL REPORT  
***************************************************")
        (shsm
         "******************** FINAL REPORT  
***************************************************")

        (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 warnlist 
        (setq any t)
        (shsm 
"*******************************************************************************")
        (shsm "These packages look ok to us, but you might want to check for 
yourself:")
        (shsm (format "%s" (mapconcat 'identity 
                                      (mapcar (lambda (a) 
                                                (format "%s:\n%s"
                                                        (first a) (second a)))
                                              warnlist)
                                      "\n"))))


      (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 OFTHES 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 is *not*
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 "Type\n%s %s"
              "apt-get -u -t stable install "
              (mapconcat 'identity
                         stables " "))
        
        (shsm "\nWith proper apt-pinning, this might be equivalent to:\n"
              "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 Debia 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. 

 1 ==> THIS PACKAGE DOES NOT HAVE A FIX YET

 2 ==> THIS PACKAGE IS OK, BUT WE ARE NOT SURE.

 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 IS 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)))
         (uptodatep (and (listp vlist) (equal (third vlist) "uptodate")))
         (cstableneeded (ignore-errors (dsa-version-sign installed 
stableneeded)))
         (csidneeded (ignore-errors (dsa-version-sign installed
                                                      sidneeded))))

    (setq 
     code
     (cond
      ((equal vlist 'error) 3)
      ((null vlist)
       -1)
      ;; couldn't parse cstable 
      ((null cstableneeded)
       (cond
        ;; couldn't parse csidneeded
        ((null csidneeded) 3)
        ;; we are even better than sid's NEEDED.. so, ok, but let's flag
        ;; it unsure but ok, now we just need to return either 2
        ;; or 4.
        ((>= csidneeded 0) (list 'sid 2 4))
        
        ;; if lower than sid but couldn't parse the stable
        ;; requirement, we don't know what is needed. So, barf.
        (t 3)))
      
      ;; couldn't parse csidneeded 
      ((null csidneeded)
       (cond
        ;; couldn't parse cstable needed
        ((null cstableneeded) 3)
        ;; we are exactly at what's stable needed and we don't care that
        ;; csidneeded didn't get parsed, but later stables MAY still be
        ;; available, in which case an upgrade is certainly desirable,
        ;; so we want to return -1 or 5 here.
        ((= cstableneeded 0) (list 'stable -1 5))
        (t 3)))
      
      
      ;; EQUAL to the needed stable 
      ((= cstableneeded 0) (list 'stable -1 5))
      ;;better than the needed sid: 
      ((>= csidneeded 0) (list 'sid -1 4))
      ;; worse then the needed stable:
      ((< cstableneeded 0) 5)
      
      ;; worse than sid: (but better than stable due to above..)
      ((and (< csidneeded 0) (> cstableneeded 0) 5) (list 'sid 0 1))
      
      ;; better than csidneeded: return 
      (t 3)
      ))
    
    ;; We have these possibilities: 
    ;; sid (2 4), (-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 '(2 4))
                 (if (not uptodatep) 4 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)

Attachment: dsa
Description: script


reply via email to

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