From 64d4c1d6803b7e73453f1498a14067dbb1ab3297 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 5 Mar 1996 18:33:21 +0000
Subject: [PATCH] Added a check after the FILE-ATTRIBUTES-DIRECT call.  The
 attributes will be #F if the file is a symlink to hyperspace.  Failure to
 check was causing a SIGSEGV; now it print a warning.

This still leaves the problem of symbolic link loops.  I `fixed' this
in the one place it was occuring by altering the symlinks.
---
 v7/src/rcs/logmer.scm | 46 ++++++++++++++++++++++++-------------------
 1 file changed, 26 insertions(+), 20 deletions(-)

diff --git a/v7/src/rcs/logmer.scm b/v7/src/rcs/logmer.scm
index 6d59b399f..1b9209193 100644
--- a/v7/src/rcs/logmer.scm
+++ b/v7/src/rcs/logmer.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: logmer.scm,v 1.14 1996/03/03 22:58:35 cph Exp $
+$Id: logmer.scm,v 1.15 1996/03/05 18:33:21 adams Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -183,25 +183,31 @@ MIT in each case. |#
 
     (define (scan-file pathname original-pathname)
       (let ((attributes (file-attributes-direct pathname)))
-	(let ((type (file-attributes/type attributes)))
-	  (cond ((not type)
-		 (if (not (or (ignored-file-name? pathname)
-			      (ignored-file-name? original-pathname)))
-		     (let ((control (rcs-control-file pathname)))
-		       (if control
-			   (begin
-			     (set! files
-				   (cons (cons original-pathname control)
-					 files))
-			     unspecific)))))
-		((eq? type #t)
-		 (if (not (member (file-namestring pathname)
-				  '("." ".." "RCS")))
-		     (scan-directory pathname original-pathname)))
-		((string? type)
-		 (scan-file (merge-pathnames type
-					     (directory-pathname pathname))
-			    original-pathname))))))
+	(if (not attributes)
+	    (warn "Cannot get attributes.  Path might contain stale symlink."
+		  (error-irritant/noise "\n;   ")
+		  original-pathname
+		  (error-irritant/noise "\n; points to\n;   ")
+		  pathname)
+	    (let ((type (file-attributes/type attributes)))
+	      (cond ((not type)
+		     (if (not (or (ignored-file-name? pathname)
+				  (ignored-file-name? original-pathname)))
+			 (let ((control (rcs-control-file pathname)))
+			   (if control
+			       (begin
+				 (set! files
+				       (cons (cons original-pathname control)
+					     files))
+				 unspecific)))))
+		    ((eq? type #t)
+		     (if (not (member (file-namestring pathname)
+				      '("." ".." "RCS")))
+			 (scan-directory pathname original-pathname)))
+		    ((string? type)
+		     (scan-file (merge-pathnames type
+						 (directory-pathname pathname))
+				original-pathname)))))))
 
     (define (rcs-control-file pathname)
       (let ((directory (directory-pathname pathname))
-- 
2.25.1