From 379e712cb49f3e249bd5c50e41ec02bc40411816 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 18 Sep 2015 06:11:46 -0700
Subject: Improved ~/.txr_profile checks, with security.

* parser.c (load_rcfile): Use path-exists-p for the existence
check. Since that doesn't throw, it's outside of the
catch section. Use path-private-to-me-p to impose a security
check on the profile file.  If an error exception is caught,
show the details.

* txr.1: Added notes about security check.
---
 parser.c | 21 +++++++++++++++------
 txr.1    | 14 ++++++++++++--
 2 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/parser.c b/parser.c
index ddc0d22d..e0bf0c69 100644
--- a/parser.c
+++ b/parser.c
@@ -375,12 +375,21 @@ static void load_rcfile(val name)
   val resolved_name;
   val lisp_p = t;
   val stream = nil;
-  val stat = nil;
   val catch_syms = cons(error_s, nil);
+  val path_private_to_me_p =  intern(lit("path-private-to-me-p"), user_package);
+  val path_exists_p =  intern(lit("path-exists-p"), user_package);
 
-  uw_catch_begin (catch_syms, sy, va);
+  if (!funcall1(path_exists_p, name))
+    return;
+
+  if (!funcall1(path_private_to_me_p, name)) {
+    format(std_output,
+           lit("** possible security problem: ~a is writable to others\n"),
+           name, nao);
+    return;
+  }
 
-  stat = statp(name);
+  uw_catch_begin (catch_syms, sy, va);
 
   open_txr_file(name, &lisp_p, &resolved_name, &stream);
 
@@ -390,9 +399,9 @@ static void load_rcfile(val name)
   uw_catch(sy, va)
   {
     (void) va;
-    if (stat)
-      format(std_output, lit("** type ~s exception while loading ~s\n"),
-             sy, name, nao);
+    format(std_output, lit("** type ~s exception while loading ~a\n"),
+           sy, name, nao);
+    format(std_output, lit("** details: ~a\n"), car(va), nao);
   }
 
   uw_unwind;
diff --git a/txr.1 b/txr.1
index 4a1d39dc..6b6491cd 100644
--- a/txr.1
+++ b/txr.1
@@ -33839,13 +33839,23 @@ in the user's home directory, as determined by the
 environment variable. If that variable doesn't exist, no further attempt is
 made to locate this file.
 
-If it exists, the file is expected to be readable and to contain
+If the file exists, it is subject to a security check.
+The function
+.code path-private-to-me-p
+is applied to the file. If it returns
+.code nil
+then an error message is displayed and the file is not loaded.
+
+If the file passes the security check, it is expected to be readable and
+to contain
 \*(TL forms, which are read and evaluated.
 Syntax errors encountered while reading the profile file are displayed
 on standard output, and any exceptions thrown that are derived from
 .code error
 are caught and displayed.  The interactive listener starts in spite of these
-situations.  Exceptions not derived from error will terminate the process.
+situations.  Exceptions not derived from
+.code error
+will terminate the process.
 
 The profile file is not read by non-interactive invocations of \*(TX:
 that is, when the
-- 
cgit v1.2.3