;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 12/02/88 11:18:55 by CORNISH,
;;; Reason: Changed :AFTER :CLOSE method of NFS-BUFFERED-OUTPUT-STREAM to not modify
;;; the MODE of the file being closed is that file is not on the associated
;;; microExplorer.  MODE has a privatge meaning to the microExplorer which 
;;; is highly inappropriate on a true NFS host. 
;;; while running on MX7 from band NA27
;;; With SYSTEM 5.19, GC 5.3, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.6, BASIC-FILE 5.3, RPC 5.4, NFS 5.10, EH 5.3, MAKE-SYSTEM 5.2,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.25, COMPILER 5.1, TV 5.21, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.9, DEBUG-TOOLS 5.1, WINDOW-MX 5.28, PRINTER 5.11, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.33, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.3, TELNET 5.1,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.45, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 96, Band Name: microExplorer Network (10/27)

#!C
; From file NFS_STREAM.LISP#> NFS; SYS:
#10R NETWORK-FILE-SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NETWORK-FILE-SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: NFS; NFS_STREAM.É#É"


(DEFMETHOD (NFS-BUFFERED-OUTPUT-STREAM :AFTER :CLOSE) (&optional mode)
   (block :close
     (flet ((SET-ATTRIBUTES (attributes)
	      ;; We have stored info from copy-file operation (6/27/88)
	      (WHEN (EQ fs:*MAC-NFS-COPY-FHANDLE* (SEND self :pathname))
		(SETF (sattr-mtime-sec attributes) (rpc:lisp-unix-ut fs:*MAC-NFS-COPY-CREATION-DATE*) )
		(SETF (sattr-mtime-usec attributes) 0)
		;(FORMAT t "~%Mtime = ~d, Usec = ~d" (sattr-mtime-sec attributes)
		;	(sattr-mtime-usec attributes))
		) ;; when performance
	      
	      (let ((reply                nil))
		(send (send client :new-xid) :call NFSPROC-SETATTR
		      #'xdr-setattr-arg (make-setattr-arg fhandle attributes)
		      #'xdr-attrstat    (locf reply) credentials)
		(if (not (integerp reply))
		    ;; then the SETATTR worked, so record the FATTR it returned
		    (setf (file-attributes client truename) reply
			  fattr                             reply)

		    ;; else the SETATTR failed  but we still need the final FATTR
		    (progn
		      (send (send client :new-xid) :call NFSPROC-GETATTR
			    #'xdr-fhandle   fhandle
			    #'xdr-attrstat (locf reply) credentials)
		      (when (not (integerp reply))
		          ;; then the GETATTR worked, so record the FATTR it returned
			(setf (file-attributes client truename) reply
			      fattr                             reply))))
		
		(send self :setplist (fattr-plist truename fattr (send self :plist)))
		(send self :putprop byte-size :BYTE-SIZE)
		(send self :putprop (send self :characters) :characters)
		(send self :putprop (send self :length) :LENGTH-IN-BYTES)))
	    );flet binding

       (if (eq mode :ABORT)
	   ;; then this is a aborted close, so try to put things back the way they were
	   (progn (setf (file-attributes client truename) nil)  ; always flush the cache
		  (when (and modified-p (= NFS-OK (nfs-status (look-up client truename credentials))))
		    ;; then a new file exists, so try to delete it 
		    (when (errorp (send self :delete nil)) (return-from :close)))
		  );progn

	    ;; else this is a normal close
	   (let ((new-size 0))
	     (when (and (variable-boundp si:output-pointer-base)       (integerp si:output-pointer-base)
			(variable-boundp si:stream-output-index)       (integerp si:stream-output-index)
			(variable-boundp si:stream-output-lower-limit) (integerp si:stream-output-lower-limit))
	       ;; then apparently something was written, so calculate the new size
	       (setf new-size (byte-count (+ si:output-pointer-base
					     (- si:stream-output-index si:stream-output-lower-limit)))))

	     ;; record the new size
	     (set-attributes (make-sattr :mode (if (rpc:local-mac-p (pathname-host truename))        
					             (if (send self :characters) 1 0)
						     SATTR-IGNORED)
					 :size (if (eq if-exists :OVERWRITE)
						   ;; then new size is max of old and new
						   (max new-size (fattr-size fattr))
						     
						   ;; else it is just the new size
						   new-size)))) 
	    );;if
       );;flet
     );;block
   )
))
