  -*- Mode : LISP ; Syntax : Common - Lisp ; Package : USER ; Base : 10 ; Patch - File : t -*-
  Patch file for CL - HTTP version 70.187
;;; Reason: Function (CLOS:METHOD HTTP:UPDATE-USER (HTTP::USER)):  don't lose when password is NIL.
  Written by JCMa , 11/19/03 22:24:20
  while running on FUJI - VLM from FUJI:/usr / lib / symbolics / ComLink-39 - 8 - F - MIT-8 - 5 - inc1.vlod
  with Open Genera 2.0 , Genera 8.5 , Lock Simple 437.0 , Version Control 405.0 ,
  Compare Merge 404.0 , VC Documentation 401.0 ,
  Logical Pathnames Translation Files NEWEST , CLIM 72.0 , Genera CLIM 72.0 ,
  PostScript CLIM 72.0 , MAC 414.0 , 8 - 5 - Patches 2.19 , Statice Runtime 466.1 ,
  Statice 466.0 , Statice Browser 466.0 , Statice Documentation 426.0 ,   ,
  CLIM Documentation 72.0 , Showable Procedures 36.3 , Binary Tree 34.0 ,
  Mailer 438.0 , Working LispM Mailer 8.0 , HTTP Server 70.186 ,
  W3 Presentation System 8.1 , CL - HTTP Server Interface 53.0 ,
  Symbolics Common Lisp Compatibility 4.0 , Comlink Packages 6.0 ,
  Comlink Utilities 10.4 , COMLINK Cryptography 2.0 , Routing Taxonomy 9.0 ,
  COMLINK Database 11.26 , Email Servers 12.0 , Comlink Customized LispM Mailer 7.1 ,
  Dynamic Forms 14.5 , Communications Linker Server 39.8 ,
  Lambda Information Retrieval System 22.5 , Experimental Genera 8 5 Patches 1.0 ,
  Genera 8 5 System Patches 1.41 ,  8 5 Mailer Patches 1.1 ,
  Genera 8 5    ,  8 5 Statice Runtime Patches 1.0 ,
  Genera 8 5 Statice Patches 1.0 , Genera 8 5 Statice Documentation Patches 1.0 ,
  Genera 8 5 Clim Patches 1.3 ,  8 5   Patches 1.0 ,
  Genera 8 5 Postscript Clim Patches 1.0 ,  8 5 Clim Doc Patches 1.0 ,
  Genera 8 5 Image Substrate Patches 1.0 ,  8 5 Lock Simple Patches 1.0 ,
  Jcma 44 , HTTP Client 51.6 , HTTP Client Substrate 4.23 , Image Substrate 440.4 ,
  Essential Image Substrate 433.0 , Ivory Revision 5 , VLM Debugger 329 ,
  Genera program 8.18 , DEC OSF/1 V4.0 ( Rev. 110 ) ,
  1585x1133 1 - bit STATIC - GRAY X Screen RELATUS:0.0 with 224 Genera fonts ( eXodus 8.0   ( c ) 2001 Powerlan USA ,
;;; Inc. R7100),
  1152x696 24 - bit TRUE - COLOR X Screen FUJI:2.0 with 224 Genera fonts ( The Olivetti & Oracle Research Laboratory R3323 ) ,
  Machine serial number -2141194968 ,
  Domain Fixes ( from CML : MAILER;DOMAIN - FIXES.LISP.33 ) ,
  Do n't force in the mail - x host ( from CML : MAILER;MAILBOX - FORMAT.LISP.24 ) ,
  Make Mailer More Robust ( from CML : MAILER;MAILER - FIXES.LISP.15 ) ,
;;; Patch TCP hang on close when client drops connection. (from HTTP:LISPM;SERVER;TCP-PATCH-HANG-ON-CLOSE.LISP.10),
  Add CLIM presentation and text style format directives . ( from FV : SCLC;FORMAT.LISP.20 ) ,
  Fix Statice Lossage ( from CML : LISPM;STATICE - PATCH.LISP.3 ) ,
  Make update schema work on set - value attributes with accessor names ( from CML : LISPM;STATICE - SET - VALUED - UPDATE.LISP.1 ) ,
  COMLINK Mailer Patches . ( from CML : LISPM;MAILER - PATCH.LISP.107 ) ,
  Clim patches ( from CML : DYNAMIC - FORMS;CLIM - PATCHES.LISP.48 ) ,
  Domain ad host patch ( from  > domain - ad - host - patch.lisp.21 ) ,
  Background dns refreshing ( from  > background - dns - refreshing ) .



(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE 
  "HTTP:SERVER;AUTHENTICATION.LISP.158")


;========================
(SCT:BEGIN-PATCH-SECTION)
(SCT:PATCH-SECTION-SOURCE-FILE "HTTP:SERVER;AUTHENTICATION.LISP.158")
(SCT:PATCH-SECTION-ATTRIBUTES
  "-*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: http -*-")

(defmethod update-user ((user user) &key (personal-name nil personal-name-supplied-p)
                        (email-address nil email-address-supplied-p) (password nil password-supplied-p)
                        groups &allow-other-keys
                        &aux realm)
  (flet ((get-user-realm ()
           (or realm (setq realm (user-realm user)))))
    (declare (inline get-user-realm))
    (cond-every
      (email-address-supplied-p ;; change the users's email address
        (setf (user-email-address user) email-address))
      (personal-name-supplied-p ;; Change the user's personal name.
        (setf (user-personal-name user) (or personal-name "")))
      (password-supplied-p ;;change the user's password
        (setf (user-password-digest user) (when password (make-user-password-digest (get-user-realm) user password)))))
    (let* ((current-groups (user-groups user))
           (n-groups (loop for g in groups
                           collect (intern-group (get-user-realm) g)))
           (add-groups (set-difference n-groups current-groups))
           (del-groups (set-difference current-groups n-groups)))
      (declare (dynamic-extent n-groups add-groups del-groups))
      (dolist (g add-groups)
        (group-add-user g user))
      (dolist (g del-groups)
        (group-remove-user g user)))
    user))


 Syntax : Common - Lisp ; Package : USER ; Base : 10 ; Patch - File : t -*-
 Reason: Function (CLOS:METHOD HTTP:UPDATE-USER (HTTP::USER)):  don't lose when password is NIL.
 Inc. R7100),
DOMAIN - FIXES.LISP.33 ) ,
MAILBOX - FORMAT.LISP.24 ) ,
MAILER - FIXES.LISP.15 ) ,
 Patch TCP hang on close when client drops connection. (from HTTP:LISPM;SERVER;TCP-PATCH-HANG-ON-CLOSE.LISP.10),
FORMAT.LISP.20 ) ,
STATICE - PATCH.LISP.3 ) ,
STATICE - SET - VALUED - UPDATE.LISP.1 ) ,
MAILER - PATCH.LISP.107 ) ,
CLIM - PATCHES.LISP.48 ) ,
========================
 change the users's email address
 Change the user's personal name.
change the user's password
  Patch file for CL - HTTP version 70.187
  Written by JCMa , 11/19/03 22:24:20
  while running on FUJI - VLM from FUJI:/usr / lib / symbolics / ComLink-39 - 8 - F - MIT-8 - 5 - inc1.vlod
  with Open Genera 2.0 , Genera 8.5 , Lock Simple 437.0 , Version Control 405.0 ,
  Compare Merge 404.0 , VC Documentation 401.0 ,
  Logical Pathnames Translation Files NEWEST , CLIM 72.0 , Genera CLIM 72.0 ,
  PostScript CLIM 72.0 , MAC 414.0 , 8 - 5 - Patches 2.19 , Statice Runtime 466.1 ,
  Statice 466.0 , Statice Browser 466.0 , Statice Documentation 426.0 ,   ,
  CLIM Documentation 72.0 , Showable Procedures 36.3 , Binary Tree 34.0 ,
  Mailer 438.0 , Working LispM Mailer 8.0 , HTTP Server 70.186 ,
  W3 Presentation System 8.1 , CL - HTTP Server Interface 53.0 ,
  Symbolics Common Lisp Compatibility 4.0 , Comlink Packages 6.0 ,
  Comlink Utilities 10.4 , COMLINK Cryptography 2.0 , Routing Taxonomy 9.0 ,
  COMLINK Database 11.26 , Email Servers 12.0 , Comlink Customized LispM Mailer 7.1 ,
  Dynamic Forms 14.5 , Communications Linker Server 39.8 ,
  Lambda Information Retrieval System 22.5 , Experimental Genera 8 5 Patches 1.0 ,
  Genera 8 5 System Patches 1.41 ,  8 5 Mailer Patches 1.1 ,
  Genera 8 5    ,  8 5 Statice Runtime Patches 1.0 ,
  Genera 8 5 Statice Patches 1.0 , Genera 8 5 Statice Documentation Patches 1.0 ,
  Genera 8 5 Clim Patches 1.3 ,  8 5   Patches 1.0 ,
  Genera 8 5 Postscript Clim Patches 1.0 ,  8 5 Clim Doc Patches 1.0 ,
  Genera 8 5 Image Substrate Patches 1.0 ,  8 5 Lock Simple Patches 1.0 ,
  Jcma 44 , HTTP Client 51.6 , HTTP Client Substrate 4.23 , Image Substrate 440.4 ,
  Essential Image Substrate 433.0 , Ivory Revision 5 , VLM Debugger 329 ,
  Genera program 8.18 , DEC OSF/1 V4.0 ( Rev. 110 ) ,
  1585x1133 1 - bit STATIC - GRAY X Screen RELATUS:0.0 with 224 Genera fonts ( eXodus 8.0   ( c ) 2001 Powerlan USA ,
  1152x696 24 - bit TRUE - COLOR X Screen FUJI:2.0 with 224 Genera fonts ( The Olivetti & Oracle Research Laboratory R3323 ) ,
  Machine serial number -2141194968 ,
  Domain ad host patch ( from  > domain - ad - host - patch.lisp.21 ) ,
  Background dns refreshing ( from  > background - dns - refreshing ) .



(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE 
  "HTTP:SERVER;AUTHENTICATION.LISP.158")


(SCT:BEGIN-PATCH-SECTION)
(SCT:PATCH-SECTION-SOURCE-FILE "HTTP:SERVER;AUTHENTICATION.LISP.158")
(SCT:PATCH-SECTION-ATTRIBUTES
  "-*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: http -*-")

(defmethod update-user ((user user) &key (personal-name nil personal-name-supplied-p)
                        (email-address nil email-address-supplied-p) (password nil password-supplied-p)
                        groups &allow-other-keys
                        &aux realm)
  (flet ((get-user-realm ()
           (or realm (setq realm (user-realm user)))))
    (declare (inline get-user-realm))
    (cond-every
        (setf (user-email-address user) email-address))
        (setf (user-personal-name user) (or personal-name "")))
        (setf (user-password-digest user) (when password (make-user-password-digest (get-user-realm) user password)))))
    (let* ((current-groups (user-groups user))
           (n-groups (loop for g in groups
                           collect (intern-group (get-user-realm) g)))
           (add-groups (set-difference n-groups current-groups))
           (del-groups (set-difference current-groups n-groups)))
      (declare (dynamic-extent n-groups add-groups del-groups))
      (dolist (g add-groups)
        (group-add-user g user))
      (dolist (g del-groups)
        (group-remove-user g user)))
    user))

