;;; -*- Mode: Common-Lisp; Package: fs; Base: 10.; Patch-File: T -*-

;;; Reason: Modified lmfs-rename-file to verify directory type is DIRECTORY when new-file is a directory. [11021]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for LOCAL-FILE version 6.2
;;; Written 03/23/90 08:31:25 by BERGER,
;;; while running on Pasteur from band LOD2
;;; With SYSTEM 6.30, VIRTUAL-MEMORY 6.3, EH 6.6, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.4, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.2, DISK-LABEL 6.0, BASIC-FILE 6.8, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.1,
;;;  COMPILER 6.14, TV 6.24, DATALINK 6.0, CHAOSNET 6.5, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.5, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.13,
;;;  DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.5, MAIL-READER 6.7, TELNET 6.1, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.7, TI-CLOS 6.40, CLEH 6.5, IP 3.58,
;;;  Experimental CLX 6.8, CLUE 6.67, X11M 6.20, Experimental BUG 11.18,  microcode 648,
;;;  Band Name: rel6.0 1/23

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

(DEFUN LMFS-RENAME-FILE (FILE NEW-DIRECTORY NEW-NAME NEW-TYPE NEW-VERSION)
  (IF (EQ NEW-DIRECTORY :UNSPECIFIC)
      (SETQ NEW-DIRECTORY (QUOTE NIL)))
  (IF (MEMBER NEW-NAME '(NIL :UNSPECIFIC) :TEST #'EQ)
      (SETQ NEW-NAME ""))
  (IF (MEMBER NEW-TYPE '(NIL :UNSPECIFIC) :TEST #'EQ)
      (SETQ NEW-TYPE ""))
  (IF (MEMBER NEW-VERSION '(NIL :UNSPECIFIC) :TEST #'EQ)
      (SETQ NEW-VERSION :NEWEST))
  (LET ((NEW-FILE
	  (IF (AND (MEMBER NEW-DIRECTORY '(NIL :ROOT) :TEST #'EQ)
		   (NOT (LOOKUP-DIRECTORY NEW-NAME T)))
	      (LMFS-CREATE-DIRECTORY NEW-NAME)
	      (LOOKUP-FILE NEW-DIRECTORY NEW-NAME NEW-TYPE NEW-VERSION :CREATE
			   (IF (EQ NEW-VERSION :NEWEST)
			       :NEW-VERSION
			       :ERROR)
			   () T)))
	(DIRECTORY (FILE-DIRECTORY FILE)))
    ;;Directory File must have a version number of LMFS-DIRECTORY-VERSION!   03.04.87 DAB
    (when  (directory? file)		;Is it a directory file? Check its attributes bit.
      ;; ; DAB 03-23-90 If file is a directory the version must be 1 and the type must be "DIRECTORY", otherwise
      ;; you will not be able to list or access the files in the directory. Also, when one of the errors below
      ;; occurs we must remove the new-file created during LOOKUP-file above.
      (cond ((not (eq (file-version new-file)  LMFS-DIRECTORY-VERSION))
	     (REMOVE-FILE-FROM-DIRECTORY new-FILE)  ; DAB 03-23-90 Remove the file created during lookup.
	     (LM-RENAME-ERROR 'RENAME-directory-version-not-1 NEW-DIRECTORY NEW-NAME NEW-TYPE NEW-VERSION))
	    ((not (string-equal (file-type new-file)  LMFS-DIRECTORY-TYPE))  ; DAB 03-23-90
	     (REMOVE-FILE-FROM-DIRECTORY new-FILE)
	     (LM-RENAME-ERROR 'RENAME-directory-type-not-directory NEW-DIRECTORY NEW-NAME NEW-TYPE NEW-VERSION)
	     )	;is the new file version 1?
	    )) 
    (LOCKING-RECURSIVELY (FILE-LOCK NEW-FILE) (SETQ NEW-VERSION (FILE-VERSION NEW-FILE))
			 (IF (NOT (NULL (FILE-OVERWRITE-FILE NEW-FILE)))
			     (LM-RENAME-ERROR 'RENAME-TO-EXISTING-FILE NEW-DIRECTORY NEW-NAME NEW-TYPE NEW-VERSION))
			 (LOCKING (FILE-LOCK FILE)
			   (WHEN (FILE-OVERWRITE-FILE FILE)
			     ;; Old file was being superseded.
			     ;; That is no longer so, though the output file is still there.
			     (LET ((OUTFILE (FILE-OVERWRITE-FILE FILE)))
			       (REPLACE-FILE-IN-DIRECTORY FILE OUTFILE)
			       (SETF (FILE-OVERWRITE-FILE FILE) ())
			       (SETF (FILE-OVERWRITE-FILE OUTFILE) ())
			       (DECF (FILE-OPEN-COUNT FILE))))
			   (WITHOUT-INTERRUPTS
			     (ALTER-FILE FILE DIRECTORY (FILE-DIRECTORY NEW-FILE) NAME NEW-NAME TYPE NEW-TYPE
					 VERSION NEW-VERSION)
			     (LOCKING-RECURSIVELY (DIRECTORY-LOCK DIRECTORY)
			       (SETF (DIRECTORY-FILES DIRECTORY)
				     (DELETE FILE (THE LIST (DIRECTORY-FILES DIRECTORY)) :TEST #'EQ :COUNT 1.))
			       (RPLACA (MEMBER NEW-FILE (DIRECTORY-FILES (FILE-DIRECTORY NEW-FILE)) :TEST #'EQ)
				       FILE))))
			 (WRITE-DIRECTORY-FILES (FILE-DIRECTORY NEW-FILE))
			 (UNLESS (EQ (FILE-DIRECTORY NEW-FILE) DIRECTORY)
			   (WRITE-DIRECTORY-FILES DIRECTORY))))
  (FILE-TRUENAME FILE))

))