From 304b03ba5183202455a71198da9dab7ac9d28ab8 Mon Sep 17 00:00:00 2001 From: Didier Verna Date: Tue, 16 Apr 2013 18:05:29 +0200 Subject: [PATCH] Protect against error in user home directory computation This is a quick fix. There are comments about other related issues and better ways to do it. 2013-04-16 Didier Verna * src/util.lisp (home-directory): New warning condition. (home-directory): Handle TRUENAME errors by returning NIL. * src/synopsis.lisp (initialize-instance): Handle NIL user home directory in the clon-search-path default value. * src/options/path.lisp (convert): Mention the bug about HOME-DIRECTORY returning NIL. * TODO: Mention the bug about static computation of the default value of the clon-search-path option. --- TODO | 4 +++- src/options/path.lisp | 5 ++++- src/synopsis.lisp | 40 ++++++++++++++++++++++++---------------- src/util.lisp | 31 ++++++++++++++++++++++++++++--- 4 files changed, 59 insertions(+), 21 deletions(-) diff --git a/TODO b/TODO index 63faa7b..626c893 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,6 @@ -*- mode: outline -*- -* Copyright (C) 2010, 2011 Didier Verna +* Copyright (C) 2010, 2011, 2013 Didier Verna This file is part of Clon. @@ -70,6 +70,8 @@ option is supposed to accept empty strings. * Support for dynamic default value / fallback computed at run-time from a lambda expression for instance. But is this different from supporting post-processing ? +Cf. also current bug in clon-search-path default computation, which is done at +compile time if defsynopsis is used as a toplevel form. * Improve advanced usage support Maybe we need a way to support declarative definition of a synopsis *tree* for diff --git a/src/options/path.lisp b/src/options/path.lisp index 9941ef9..52db128 100644 --- a/src/options/path.lisp +++ b/src/options/path.lisp @@ -1,6 +1,6 @@ ;;; path.lisp --- Path options -;; Copyright (C) 2010, 2011, 2012 Didier Verna. +;; Copyright (C) 2010, 2011, 2012, 2013 Didier Verna. ;; Author: Didier Verna ;; Maintainer: Didier Verna @@ -193,6 +193,9 @@ useful to specify which part of ARGUMENT is concerned when it is a list." :directory (list* :relative (cddr (pathname-directory pathname))) :defaults pathname) + ;; #### FIXME: this will break when the home directory + ;; cannot be found (HOME-DIRECTORY returns NIL in that + ;; case). I need to throw a conversion error. (home-directory)))) pathname))) (ecase (path-type path) diff --git a/src/synopsis.lisp b/src/synopsis.lisp index ae4c7d5..8a7f2e1 100644 --- a/src/synopsis.lisp +++ b/src/synopsis.lisp @@ -1,6 +1,6 @@ ;;; synopsis.lisp --- Synopsis management -;; Copyright (C) 2010, 2011, 2012 Didier Verna. +;; Copyright (C) 2010, 2011, 2012, 2013 Didier Verna. ;; Author: Didier Verna ;; Maintainer: Didier Verna @@ -183,22 +183,30 @@ If you don't want any search path at all, use this option with no argument." ;; everything here, plus OSX specific values that I ;; know of. Not sure about Windows or anything else. :default-value - (let ((local-path '("share/clon/")) - (global-path '(#p"/usr/local/share/clon/" - #p"/usr/share/clon/"))) + ;; #### FIXME: this is wrong. If defsynopsis is used as + ;; a toplevel form, the fallback below will be + ;; computed at compile-time although it contains things + ;; that should be computed at run-time only (like the + ;; user home directory). + (let ((path '(#p"/usr/local/share/clon/" + #p"/usr/share/clon/")) + (home-directory (home-directory))) (when (macosp) - (push "Library/Application Support/Clon/" - local-path) - (push #p"/Library/Application Support/Clon/" - global-path)) - (push ".clon/" local-path) - (append - (mapcar - (lambda (subdir) - (merge-pathnames subdir - (home-directory))) - local-path) - global-path)) + (push #p"/Library/Application Support/Clon/" path)) + (when home-directory + (let ((local-path '("share/clon/"))) + (when (macosp) + (push "Library/Application Support/Clon/" + local-path)) + (push ".clon/" local-path) + (setq path (append + (mapcar + (lambda (subdir) + (merge-pathnames subdir + home-directory)) + local-path) + path)))) + path) :env-var "SEARCH_PATH") (path "theme" ~"Set Clon's output theme. diff --git a/src/util.lisp b/src/util.lisp index 7d98fb3..98f0fea 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -1,6 +1,6 @@ ;;; util.lisp --- General utilities -;; Copyright (C) 2010, 2011, 2012 Didier Verna. +;; Copyright (C) 2010, 2011, 2012, 2013 Didier Verna. ;; Author: Didier Verna ;; Maintainer: Didier Verna @@ -277,9 +277,34 @@ Both instances share the same slot values." ;; System-related utilities ;; ========================================================================== +;; #### FIXME: this condition could be improved by having a pathname and a +;; better error-string message. But that needs to be done in a +;; compiler-dependent way. We know that the error comes from TRUENAME because +;; USER-HOMEDIR-PATHNAME cannot return nil when called without a HOST +;; option. But the actual error object signaled by TRUENAME is not standard. +(define-condition home-directory (warning) + ((error-string :initarg :error-string :accessor error-string)) + (:report (lambda (warning stream) + (format stream "cannot find home directory: ~A." + (error-string warning))))) + +;; #### FIXME: Anyway, this function is not the place to handle the error. It +;; should only provide a restart. There are currently two places where +;; HOME-DIRECTORY is used. The first one is for computing the default value of +;; the clon-search-path option, where this error is not critical. The second +;; is in the CONVERT method for the PATH options. There, the error is +;; critical. (defun home-directory () - "Return user's home directory in canonical form." - (truename (user-homedir-pathname))) + "Return user's home directory in canonical form. +If the user's home directory cannot be computed, signal a warning and return +NIL." + (handler-case (truename (user-homedir-pathname)) + (file-error (error) + (warn 'home-directory + :error-string (with-output-to-string (stream) + (let (*print-escape*) + (print-object error stream)))) + nil))) (defun macosp () "Return t if running on Mac OS." -- 2.11.4.GIT