From 15c42fa37fced6cb65b09dce07d59fc729748018 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 24 Feb 2014 20:59:18 -0800
Subject: * eval.c (eval_init): Intern symlink_wrap, link_wrap, readlink_wrap.

* stream.c (symlink_wrap, link_wrap, readlink_wrap): New functions.

* stream.h (symlink_wrap, link_wrap, readlink_wrap): Declared.

* txr.1: Documented.
---
 ChangeLog | 10 ++++++++++
 eval.c    |  3 +++
 stream.c  | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 stream.h  |  3 +++
 txr.1     | 36 ++++++++++++++++++++++++++++++++++++
 5 files changed, 110 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 445ce15e..61e35a34 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2014-02-24  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Intern symlink_wrap, link_wrap, readlink_wrap.
+
+	* stream.c (symlink_wrap, link_wrap, readlink_wrap): New functions.
+
+	* stream.h (symlink_wrap, link_wrap, readlink_wrap): Declared.
+
+	* txr.1: Documented.
+
 2014-02-24  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (eval_init): Register forgotten s_ifsock variable.
diff --git a/eval.c b/eval.c
index 5e1fa98b..e96e37ea 100644
--- a/eval.c
+++ b/eval.c
@@ -3602,6 +3602,9 @@ void eval_init(void)
   reg_fun(intern(lit("minor"), user_package), func_n1(minor_wrap));
   reg_fun(intern(lit("major"), user_package), func_n1(major_wrap));
   reg_fun(intern(lit("mknod"), user_package), func_n3(mknod_wrap));
+  reg_fun(intern(lit("symlink"), user_package), func_n2(symlink_wrap));
+  reg_fun(intern(lit("link"), user_package), func_n2(link_wrap));
+  reg_fun(intern(lit("readlink"), user_package), func_n1(readlink_wrap));
 #endif
 
 #if HAVE_SYSLOG
diff --git a/stream.c b/stream.c
index e436ee34..7fde754a 100644
--- a/stream.c
+++ b/stream.c
@@ -2419,7 +2419,9 @@ val getcwd_wrap(void)
                   num(errno), string_utf8(strerror(errno)), nao);
       }
       if (2 * guess > guess)
-        guess = 2 * guess;
+        guess *= 2;
+      else
+        uw_throwf(file_error_s, lit("getcwd: weird problem"), nao);
     } else {
       val out = string_utf8(u8buf);
       free(u8buf);
@@ -2457,6 +2459,61 @@ val mknod_wrap(val path, val mode, val dev)
   return t;
 }
 
+val symlink_wrap(val target, val to)
+{
+  char *u8target = utf8_dup_to(c_str(target));
+  char *u8to = utf8_dup_to(c_str(to));
+  int err = symlink(u8target, u8to);
+  free(u8target);
+  free(u8to);
+  if (err < 0)
+    uw_throwf(file_error_s, lit("symlink ~a ~a: ~a/~s"),
+              target, to, num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+val link_wrap(val target, val to)
+{
+  char *u8target = utf8_dup_to(c_str(target));
+  char *u8to = utf8_dup_to(c_str(to));
+  int err = link(u8target, u8to);
+  free(u8target);
+  free(u8to);
+  if (err < 0)
+    uw_throwf(file_error_s, lit("link ~a ~a: ~a/~s"),
+              target, to, num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+val readlink_wrap(val path)
+{
+  char *u8path = utf8_dup_to(c_str(path));
+  ssize_t guess = 256;
+
+  for (;;) {
+    char *u8buf = (char *) chk_malloc(guess);
+    ssize_t bytes = readlink(u8path, u8buf, guess);
+
+    if (bytes >= guess) {
+      free(u8buf);
+      if (2 * guess > guess)
+        guess *= 2;
+      else
+        uw_throwf(file_error_s, lit("readlink: weird problem"), nao);
+    } else if (bytes <= 0) {
+      free(u8buf);
+      uw_throwf(file_error_s, lit("readlink ~a: ~a/~s"),
+                path, num(errno), string_utf8(strerror(errno)), nao);
+    } else {
+      val out;
+      u8buf[bytes] = 0;
+      out = string_utf8(u8buf);
+      free(u8buf);
+      return out;
+    }
+  }
+}
+
 #endif
 
 void stream_init(void)
diff --git a/stream.h b/stream.h
index 30d89fe7..254b5cf4 100644
--- a/stream.h
+++ b/stream.h
@@ -108,5 +108,8 @@ val makedev_wrap(val major, val minor);
 val minor_wrap(val dev);
 val major_wrap(val dev);
 val mknod_wrap(val path, val mode, val dev);
+val symlink_wrap(val target, val to);
+val link_wrap(val target, val to);
+val readlink_wrap(val path);
 
 void stream_init(void);
diff --git a/txr.1 b/txr.1
index 05eacaeb..6d1c1085 100644
--- a/txr.1
+++ b/txr.1
@@ -12470,6 +12470,42 @@ Example:
 
    (mknod "dev/foo" (logior #o700 s-ifchr) (makedev 8 3))
 
+.SS Functions symlink and link
+
+.TP
+Syntax:
+
+  (symlink <target> <path>)
+  (link <target> <path>)
+
+.TP
+Description:
+
+The symlink function creates a symbolic link called <path> whose contents
+are the absolute or relative path <target>. <target> does not actually have
+to exist.
+
+The link function creates a hard link. The object at <target> is installed
+into the filesystem at <path> also.
+
+If these functions succeed, they return t. Otherwise they throw an exception
+of type file-error.
+
+
+.SS Function readlink
+
+.TP
+Syntax:
+
+  (readlink <path>)
+
+.TP
+Description:
+
+If <path> names a filesystem object which is a symbolic link, the readlink
+function reads the contents of that symbolic link and returns it
+as a string.  Otherwise, it fails by throwing an exception of type file-error.
+
 .SH UNIX SIGNAL HANDLING
 
 On platforms where certain advanced features of POSIX signal handling are
-- 
cgit v1.2.3