From: <cli...@li...> - 2008-07-11 19:07:34
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/doc impbody.xml,1.521,1.522 (Sam Steingold) 2. clisp/src ChangeLog,1.6357,1.6358 encoding.d,1.149,1.150 (Sam Steingold) 3. clisp/src ChangeLog,1.6358,1.6359 pathname.d,1.442,1.443 (Sam Steingold) 4. clisp/src ChangeLog, 1.6359, 1.6360 TODO, 1.145, 1.146 init.lisp, 1.277, 1.278 (Sam Steingold) 5. clisp/doc faq.xml,1.85,1.86 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 10 Jul 2008 19:16:36 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc impbody.xml,1.521,1.522 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv31038/doc Modified Files: impbody.xml Log Message: (cond-fname): add Index: impbody.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v retrieving revision 1.521 retrieving revision 1.522 diff -u -d -r1.521 -r1.522 --- impbody.xml 12 Jun 2008 16:35:59 -0000 1.521 +++ impbody.xml 10 Jul 2008 19:16:34 -0000 1.522 @@ -1221,12 +1221,17 @@ <section id="cond-nl"><title>Embedded Newlines in Condition Reports <ulink role="clhs" url="sec_9-1-3-1-3"/></title> - <para>The error message prefix for the first line is <quote>*** - </quote>. All subsequent lines are indented by 6 characters. Long lines are broken on &whitespace; (see <xref linkend="fill-stream"/>).</para> +</section> +<section id="cond-fname"><title>Mentioning Containing Function in + Condition Reports <ulink role="clhs" url="sec_9-1-3-1-5"/></title> +<para>Contrary to the recommendation of the standard, &clisp; usually + does print the name of the containing function to simplify debugging + in batch mode, see &exit-on-error;.</para> </section> <section id="restarts"><title>Interfaces to Restarts ------------------------------ Message: 2 Date: Thu, 10 Jul 2008 21:49:24 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6357,1.6358 encoding.d,1.149,1.150 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv1160/src Modified Files: ChangeLog encoding.d Log Message: (error_nls_invalid): print function name Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6357 retrieving revision 1.6358 diff -u -d -r1.6357 -r1.6358 --- ChangeLog 10 Jul 2008 16:12:45 -0000 1.6357 +++ ChangeLog 10 Jul 2008 21:49:20 -0000 1.6358 @@ -1,5 +1,9 @@ 2008-07-10 Sam Steingold <sd...@gn...> + * encoding.d (error_nls_invalid): print function name + +2008-07-10 Sam Steingold <sd...@gn...> + * debug.d (read_form): fix a GC-safety bug (save function before subsstring) * foreign.d (check_faddress_valid): fix a GC-safety bug Index: encoding.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/encoding.d,v retrieving revision 1.149 retrieving revision 1.150 diff -u -d -r1.149 -r1.150 --- encoding.d 31 May 2008 22:08:05 -0000 1.149 +++ encoding.d 10 Jul 2008 21:49:21 -0000 1.150 @@ -1591,7 +1591,8 @@ pushSTACK(TheEncoding(encoding)->enc_charset); pushSTACK(ascii_char(hex_table[b&0x0F])); pushSTACK(ascii_char(hex_table[(b>>4)&0x0F])); - error(error_condition,GETTEXT("invalid byte #x~C~C in ~S conversion")); + pushSTACK(TheSubr(subr_self)->name); + error(error_condition,GETTEXT("~S: invalid byte #x~C~C in ~S conversion")); } global uintL nls_mblen (object encoding, const uintB* src, ------------------------------ Message: 3 Date: Thu, 10 Jul 2008 21:49:58 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6358,1.6359 pathname.d,1.442,1.443 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv1183/src Modified Files: ChangeLog pathname.d Log Message: (check_no_wildcards): print function name Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.442 retrieving revision 1.443 diff -u -d -r1.442 -r1.443 --- pathname.d 1 Jul 2008 14:08:51 -0000 1.442 +++ pathname.d 10 Jul 2008 21:49:55 -0000 1.443 @@ -3861,8 +3861,8 @@ return; /* error-message, if the pathname contains wildcards: */ pushSTACK(pathname); /* FILE-ERROR slot PATHNAME */ - pushSTACK(pathname); - error(file_error,GETTEXT("wildcards are not allowed here: ~S")); + pushSTACK(pathname); pushSTACK(TheSubr(subr_self)->name); + error(file_error,GETTEXT("~S: wildcards are not allowed here: ~S")); } LISPFUN(wild_pathname_p,seclass_read,1,1,norest,nokey,0,NIL) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6358 retrieving revision 1.6359 diff -u -d -r1.6358 -r1.6359 --- ChangeLog 10 Jul 2008 21:49:20 -0000 1.6358 +++ ChangeLog 10 Jul 2008 21:49:54 -0000 1.6359 @@ -1,6 +1,7 @@ 2008-07-10 Sam Steingold <sd...@gn...> * encoding.d (error_nls_invalid): print function name + * pathname.d (check_no_wildcards): ditto 2008-07-10 Sam Steingold <sd...@gn...> ------------------------------ Message: 4 Date: Thu, 10 Jul 2008 22:00:03 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog, 1.6359, 1.6360 TODO, 1.145, 1.146 init.lisp, 1.277, 1.278 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv5119/src Modified Files: ChangeLog TODO init.lisp Log Message: (search-file <final def>): do not use DIRECTORY when the pathname is non-wild to avoid the denial-of-service attack Index: init.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/init.lisp,v retrieving revision 1.277 retrieving revision 1.278 diff -u -d -r1.277 -r1.278 --- init.lisp 22 Feb 2008 17:33:54 -0000 1.277 +++ init.lisp 10 Jul 2008 22:00:00 -0000 1.278 @@ -2124,50 +2124,75 @@ ;; We search in the current directory and then in the directories ;; listed in *load-paths*. ;; If an extension is specified in the filename, we search only for -;; files with this extension. If no extension is specified, we search -;; only for files with an extension from the given list. -;; The return value is a list of all matching files from the first directory +;; files with this extension. If no extension is specified, we additionally +;; search for files with an extension from the given list. +;; The return value is a list of all matching files from the ALL directories ;; containing any matching file, sorted according to decreasing FILE-WRITE-DATE ;; (i.e. from new to old), or NIL if no matching file was found. -(defun search-file (filename extensions - &aux (use-extensions (null (pathname-type filename))) ) - ;; merge in the defaults: - (setq filename (merge-pathnames filename '#"*.*")) - ;; search: - (let ((already-searched nil)) - (dolist (dir (cons '#"" - ;; when filename has "..", ignore *load-paths* - ;; (to avoid errors with "**/../foo"): - (if (memq :UP (pathname-directory filename)) - '() - (mapcar #'pathname *load-paths*)))) - (let ((search-filename (merge-pathnames (merge-pathnames filename dir)))) - (unless (member search-filename already-searched :test #'equal) - (let ((xpathnames (directory search-filename :full t :circle t - :if-does-not-exist :ignore))) - (when (eq :wild (pathname-type search-filename)) - (setq xpathnames - (nconc xpathnames - (directory (make-pathname - :type nil :defaults search-filename) - :if-does-not-exist :ignore - :full t :circle t)))) - (when (and use-extensions extensions) - ;; filter the extensions - (setq xpathnames - (delete-if-not ; does xpathname have the given extensions? - #'(lambda (xpathname) - (member (pathname-type (first xpathname)) extensions - :test #-WIN32 #'string= - #+WIN32 #'string-equal)) - xpathnames))) - (when xpathnames - ;; reverse sort by date: - (dolist (xpathname xpathnames) - (setf (rest xpathname) - (apply #'encode-universal-time (third xpathname)))) - (return (mapcar #'first (sort xpathnames #'> :key #'rest))))) - (push search-filename already-searched)))))) +(defun search-file (filename extensions) + ;; <http://article.gmane.org/gmane.lisp.clisp.general:9893> + ;; <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=443520> + ;; <http://article.gmane.org/gmane.lisp.clisp.devel/18532> + ;; we use DIRECTORY only for *LOAD-PATHS* elements with wild components + ;; to avoid the denial-of-service attack whereas a file in $HOME + ;; with a name incompatible with *PATHNAME-ENCODING* prevents CLISP from + ;; starting up (unless -norc or -E 1:1 is passed) + ;; because (DIRECTORY "~/*") fails + (let* ((already-searched nil) + (path-nonW (merge-pathnames filename)) + (path-wild (merge-pathnames path-nonW '#P"*.*")) + (use-extensions (null (pathname-type path-nonW))) + (found + (mapcan + #'(lambda (dir) + (let* ((wild-p (wild-pathname-p dir)) + (search-filename + (merge-pathnames (if wild-p path-wild path-nonW) dir))) + (unless (member search-filename already-searched :test #'equal) + (push search-filename already-searched) + (let ((xpathnames + (if wild-p + (nconc + (directory search-filename :full t :circle t + :if-does-not-exist :ignore) + (and (eq :wild (pathname-type search-filename)) + (directory (make-pathname :type nil :defaults search-filename) + :if-does-not-exist :ignore + :full t :circle t))) + (let ((f (probe-file search-filename)) + (e (and use-extensions extensions + (mapcan #'(lambda (ext) + (let ((f (probe-file (make-pathname :type ext :defaults search-filename)))) + (and f (list (cons f (file-write-date f)))))) + extensions)))) + (if f + (acons f (file-write-date f) e) + e))))) + (when (and wild-p use-extensions extensions) + ;; filter the extensions + (setq xpathnames + (delete-if-not + #'(lambda (xpathname) + (let ((ext (pathname-type (first xpathname)))) + (or (null ext) ; no extension - good! + (member ext extensions + :test #-WIN32 #'string= + #+WIN32 #'string-equal)))) + xpathnames))) + (if wild-p + (dolist (xpathname xpathnames) + (setf (rest xpathname) + (apply #'encode-universal-time + (third xpathname)))) + xpathnames))))) + (cons '#P"" + ;; when filename has "..", ignore *load-paths* + ;; (to avoid errors with "**/../foo"): + (if (memq :UP (pathname-directory path-nonW)) + '() + (mapcar #'pathname *load-paths*)))))) + (mapcar #'car (sort (delete-duplicates found :test #'equal) + #'> :key #'cdr)))) (LOAD "room") ; room, space Index: TODO =================================================================== RCS file: /cvsroot/clisp/clisp/src/TODO,v retrieving revision 1.145 retrieving revision 1.146 diff -u -d -r1.145 -r1.146 --- TODO 8 Jul 2008 22:39:02 -0000 1.145 +++ TODO 10 Jul 2008 21:59:59 -0000 1.146 @@ -10,18 +10,6 @@ (sds - but bruno has to fix the risky-test in iofkts.tst first) -<http://article.gmane.org/gmane.lisp.clisp.general:9893>: -DIRECTORY, *PATHNAME-ENCODING*, and Denial-Of-Service attack -I would call this an error in clisp: if it lists a directory -over which a user has no control (e.g., /tmp), then it is trivial for -an adversary to create a denial-of-service attack. -Unix pathnames are not strictly in any particular character encoding: -they are merely byte strings in which only slash and NUL have special -significance. -Should *PATHNAME-ENCODING* be 1:1? -See also <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=443520> - - Inefficiency of class redefinition when old or new class is unfinalizable Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6359 retrieving revision 1.6360 diff -u -d -r1.6359 -r1.6360 --- ChangeLog 10 Jul 2008 21:49:54 -0000 1.6359 +++ ChangeLog 10 Jul 2008 21:59:58 -0000 1.6360 @@ -1,5 +1,10 @@ 2008-07-10 Sam Steingold <sd...@gn...> + * init.lisp (search-file <final def>): do not use DIRECTORY when + the pathname is non-wild to avoid the denial-of-service attack + +2008-07-10 Sam Steingold <sd...@gn...> + * encoding.d (error_nls_invalid): print function name * pathname.d (check_no_wildcards): ditto ------------------------------ Message: 5 Date: Thu, 10 Jul 2008 22:00:00 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc faq.xml,1.85,1.86 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv5119/doc Modified Files: faq.xml Log Message: (search-file <final def>): do not use DIRECTORY when the pathname is non-wild to avoid the denial-of-service attack Index: faq.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/faq.xml,v retrieving revision 1.85 retrieving revision 1.86 diff -u -d -r1.85 -r1.86 --- faq.xml 7 Jul 2008 16:34:44 -0000 1.85 +++ faq.xml 10 Jul 2008 21:59:58 -0000 1.86 @@ -627,10 +627,8 @@ <olink targetdoc="man" targetptr="opt-enc"/>.</para> <para>This may also be caused by filesystem access. - If your &path-enc; is set incorrectly, many filesystem accesses (like - &load;, &directory; etc) will raise this error. - Note that &load; will traverse the directories mentioned in &load-paths; - - this applies to the <link linkend="faq-rc">init (RC) file</link> too. + If you have files names incompatible with your &path-enc;, + filesystem access (e.g., &directory;) will signal this error. You will need to set &path-enc; or pass &opt-E; to &clisp;. Using a <quote>1:1</quote> encoding, such as &iso-8859-1;, should help you avoid this error.</para> ------------------------------ ------------------------------------------------------------------------- Sponsored by: SourceForge.net Community Choice Awards: VOTE NOW! Studies have shown that voting for your favorite open source project, along with a healthy diet, reduces your potential for chronic lameness and boredom. Vote Now at http://www.sourceforge.net/community/cca08 ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 27, Issue 19 ***************************************** |