system: Fix infinite loop in link-target (on Unix)

Also added `follow-links?` keyword argument and a test.

`$EINVAL` became unused and started causing a warning. I removed it
from *-magic-numbers.dylan for all platforms without testing since it's not exported and
all Unixen share the same implementation of link-target, which was the only place it was
used.

Fixes #1408

Author: cgay

documentation/source/library-reference/system/file-system.rst

@@ -79,7 +79,7 @@ properties of the file.
 - :func:`file-properties`
 - :func:`file-property`
 - :func:`file-type`
-- :func:`link-target`
+- :gf:`link-target`
 - :gf:`resolve-file`
 
 File system locators
@@ -1072,7 +1072,7 @@ File-System module.
      another file or directory.
 
      This function does not resolve symbolic links.  To find the file type of the link
-     target call :func:`link-target` or :gf:`resolve-file` on *file* first.
+     target call :gf:`link-target` or :gf:`resolve-file` on *file* first.
 
 .. type:: <file-type>
 
@@ -1120,17 +1120,33 @@ File-System module.
      permissions set on the file are incorrect or insufficient for
      your operation.
 
-.. function:: link-target
+.. generic-function:: link-target
 
    Returns the target of a symbolic link.
 
-   :signature: link-target *file* => *target*
+   .. note:: On Windows this function is not implemented; it always signals an error.
+
+   :signature: link-target *file* #key *follow-links?* => *target*
    :parameter file: An instance of type :type:`<pathname>`.
-   :value target: An instance of type :type:`<pathname>`.
+   :parameter #key follow-links?: An instance of type :drm:`<boolean>`. The default is
+      :drm:`#t`.
+   :value target: :drm:`#f` or an instance of type :class:`<file-system-locator>`.
    :description:
 
-      Repeatedly follows symbolic links starting with *file* until it finds a
-      non-link file or directory, or a non-existent link target.
+      Returns a locator identifying the target of symbolic link *file*.
+
+      Signals :class:`<file-system-error>` if the system call to read the link target
+      fails for any reason. For example, if *file* is not a symbolic link or if *file*
+      does not exist.
+
+      If ``follow-links?`` is true (the default) then links are followed until a file
+      that is not a symbolic link is found, and the locator for that file is returned. If
+      the final link in a chain of one or more symbolic links points to a non-existent
+      file, :drm:`#f` is returned.
+
+      If ``follow-links?`` is false, no attempt is made to follow the link or to check
+      whether the link target file exists.  A locator representing the target is
+      returned.
 
    :seealso:
 
@@ -1314,7 +1330,7 @@ File-System module.
      - :func:`file-property-setter`
      - :func:`file-type`
      - :func:`home-directory`
-     - :func:`link-target`
+     - :gf:`link-target`
      - :func:`rename-file`
      - :func:`create-symbolic-link`
 

documentation/source/release-notes/2025.2.rst

@@ -54,5 +54,11 @@ System
   to do the same thing as the Unix implementation.  Previously it erroniously did the
   same thing as :gf:`resolve-locator`.
 
+* `Issue 1408 <https://github.com/dylan-lang/opendylan/issues/1408>`_, which could result
+  in an infinite loop in :gf:`link-target`, has been fixed.  In addition, the
+  :gf:`link-target` function accepts a new keyword argument, ``follow-links?``, which
+  specifies whether to follow all links until a non-symlink file is found (the default)
+  or just return the direct target of the given symlink.
+
 Contributors
 ============

sources/system/aarch64-linux-magic-numbers.dylan

@@ -7,7 +7,6 @@ License: Public Domain
 define constant $ENOENT = 2;
 define constant $EINTR = 4;
 define constant $EACCES = 13;
-define constant $EINVAL = 22;
 define constant $ETXTBSY = 26;
 define constant $EROFS = 30;
 define constant $path-max = 4096;

sources/system/arm-linux-magic-numbers.dylan

@@ -7,7 +7,6 @@ License: Public Domain
 define constant $ENOENT = 2;
 define constant $EINTR = 4;
 define constant $EACCES = 13;
-define constant $EINVAL = 22;
 define constant $ETXTBSY = 26;
 define constant $EROFS = 30;
 define constant $path-max = 4096;

sources/system/dump-magic-numbers.c

@@ -29,7 +29,6 @@ main(void) {
     PRINT_CONSTANT(ENOENT,  "$ENOENT");
     PRINT_CONSTANT(EINTR,   "$EINTR");
     PRINT_CONSTANT(EACCES,  "$EACCES");
-    PRINT_CONSTANT(EINVAL,  "$EINVAL");
     PRINT_CONSTANT(ETXTBSY, "$ETXTBSY");
     PRINT_CONSTANT(EROFS,   "$EROFS");
 

sources/system/file-system/file-system.dylan

@@ -8,7 +8,12 @@ Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND
 
 /// Types
 
-/// Needs a better name, I think ...
+// Needs a better name, I think ...
+//
+// I'm guessing the author of the above comment was thinking of the potential confusion
+// between "file type" and "file extension", which in turn is related to the confusion
+// between "pathname" or "locator" and "file". Locators uses the "extension" terminology
+// consistently so I think <file-type> is okay.  <file-system-entity-type>? ;) --cgay
 define constant <file-type> = one-of(#"file", #"directory", #"link");
 
 define constant <copy/rename-disposition> = one-of(#"signal", #"replace");
@@ -144,14 +149,20 @@ end method file-type;
 
 
 ///
-define generic link-target (link :: <pathname>) => (target :: <pathname>);
-
-define method link-target (link :: <file-system-locator>) => (target :: <pathname>)
-  %link-target(link)
+define generic link-target
+    (link :: <pathname>, #key follow-links?)
+ => (target :: false-or(<file-system-locator>));
+
+define method link-target
+    (link :: <file-system-locator>, #key follow-links? :: <boolean> = #t)
+ => (target :: false-or(<file-system-locator>))
+  %link-target(link, follow-links?)
 end method link-target;
 
-define method link-target (link :: <string>) => (target :: <pathname>)
-  link-target(as(<file-system-locator>, link))
+define method link-target
+    (link :: <string>, #key follow-links? :: <boolean> = #t)
+ => (target :: false-or(<file-system-locator>))
+  link-target(as(<file-system-locator>, link), follow-links?: follow-links?)
 end method link-target;
 
 

sources/system/file-system/unix-file-system.dylan

@@ -150,7 +150,7 @@ end function;
 
 define function %file-type
     (file :: <posix-file-system-locator>, #key if-does-not-exist = unsupplied())
- => (file-type :: <file-type>)
+ => (file-type :: <object>)
   with-stack-stat (st, file)
     if (primitive-raw-as-boolean
           (%call-c-function ("system_lstat") (path :: <raw-byte-string>, st :: <raw-c-pointer>)
@@ -175,11 +175,12 @@ end function %file-type;
 
 
 define function %link-target
-    (link :: <posix-file-system-locator>) => (target :: <posix-file-system-locator>)
-  while (%file-type(link, if-does-not-exist: #f) == #"link")
-    let bufsize = 8192;
+    (link :: <posix-file-system-locator>, follow-links? :: <boolean>)
+ => (target :: false-or(<posix-file-system-locator>))
+  iterate loop (link = link)
+    let bufsize = $path-max;
     let buffer = make(<byte-string>, size: bufsize, fill: '\0');
-    let count
+    let length
       = raw-as-integer(%call-c-function ("readlink")
                            (path :: <raw-byte-string>, buffer :: <raw-byte-string>,
                             bufsize :: <raw-c-size-t>)
@@ -188,16 +189,25 @@ define function %link-target
                             primitive-string-as-raw(buffer),
                             integer-as-raw(bufsize))
                        end);
-    if (count == -1)
-      unless (unix-errno() == $ENOENT | unix-errno() == $EINVAL)
-        unix-file-error("readlink", "%s", link)
-      end
+    if (length == -1)
+      unix-file-error("readlink", "%s", link);
     else
-      let target = as(<file-system-locator>, copy-sequence(buffer, end: count));
-      link := merge-locators(target, link)
+      let locator = as(<file-system-locator>, copy-sequence(buffer, end: length));
+      let target = merge-locators(locator, link);
+      if (~follow-links?)
+        target
+      else
+        let type = %file-type(target, if-does-not-exist: #f);
+        if (~type)
+          #f
+        elseif (type == #"link")
+          loop(target)
+        else
+          target
+        end
+      end
     end
-  end;
-  link
+  end iterate
 end function %link-target;
 
 

sources/system/file-system/win32-file-system.dylan

@@ -158,7 +158,8 @@ end function %file-type;
 
 ///
 define function %link-target
-    (link :: <microsoft-file-system-locator>) => (target :: <microsoft-file-system-locator>)
+    (link :: <microsoft-file-system-locator>, follow-links? :: <boolean>)
+ => (target :: <microsoft-file-system-locator>)
   error(make(<file-system-error>,
              format-string: "link-target is not available on this platform",
              format-arguments: #()))

sources/system/riscv64-linux-magic-numbers.dylan

@@ -7,7 +7,6 @@ License: Public Domain
 define constant $ENOENT = 2;
 define constant $EINTR = 4;
 define constant $EACCES = 13;
-define constant $EINVAL = 22;
 define constant $ETXTBSY = 26;
 define constant $EROFS = 30;
 define constant $path-max = 4096;

sources/system/tests/file-system.dylan

@@ -115,6 +115,25 @@ define test test-file-exists? ()
   assert-true(file-exists?(symlink-bad, follow-links?: #f));
 end test;
 
+define test test-link-target ()
+  if ($os-name ~== #"win32")    // link-target is not implemented on Windows
+    let tmp = test-temp-directory();
+    let aaa = file-locator(tmp, "aaa");
+    let bbb = file-locator(tmp, "bbb");
+    let ccc = file-locator(tmp, "ccc");
+    let ddd = file-locator(tmp, "ddd");
+    write-test-file(ddd, contents: "ddd");
+    create-symbolic-link(ddd, ccc);
+    create-symbolic-link(ccc, bbb);
+    create-symbolic-link(bbb, aaa);
+    assert-equal(link-target(aaa), ddd);
+    assert-equal(link-target(aaa, follow-links?: #f), bbb);
+    assert-signals(<file-system-error>, link-target(ddd), "ddd is not a symbolic link");
+    delete-file(ddd);
+    assert-false(link-target(aaa), "link target does not exist");
+  end if;
+end test;
+
 define test test-symbolic-link ()
   let tmp-dir = test-temp-directory();
   let symlink = file-locator(tmp-dir, "symlink-to-tmp");