Revision: 4373
Author: hans
URL: http://bknr.net/trac/changeset/4373
remove claim at the request of boris
U deployed/bos/projects/bos/payment-website/images/ring_detail.jpg
Modified: deployed/bos/projects/bos/payment-website/images/ring_detail.jpg
===================================================================
(Binary files differ)
Revision: 4372
Author: hans
URL: http://bknr.net/trac/changeset/4372
clisp fixes
U trunk/thirdparty/trivial-gray-streams/mixin.lisp
Modified: trunk/thirdparty/trivial-gray-streams/mixin.lisp
===================================================================
--- trunk/thirdparty/trivial-gray-streams/mixin.lisp 2009-04-09 05:57:32 UTC (rev 4371)
+++ trunk/thirdparty/trivial-gray-streams/mixin.lisp 2009-04-09 06:53:29 UTC (rev 4372)
@@ -79,7 +79,7 @@
(error "this stream does not support the NO-HANG argument"))
(when interactive
(error "this stream does not support the INTERACTIVE argument"))
- (stream-read-sequence s seq start end))
+ (stream-read-sequence s seq start (or end (length seq))))
(defmethod gray:stream-write-byte-sequence
((s trivial-gray-stream-mixin)
@@ -89,15 +89,15 @@
(error "this stream does not support the NO-HANG argument"))
(when interactive
(error "this stream does not support the INTERACTIVE argument"))
- (stream-write-sequence s seq start end))
+ (stream-write-sequence s seq start (or end (length seq))))
(defmethod gray:stream-read-char-sequence
((s trivial-gray-stream-mixin) seq &optional start end)
- (stream-read-sequence s seq start end))
+ (stream-read-sequence s seq start (or end (length seq))))
(defmethod gray:stream-write-char-sequence
((s trivial-gray-stream-mixin) seq &optional start end)
- (stream-write-sequence s seq start end))
+ (stream-write-sequence s seq start (or end (length seq))))
(defmethod gray:stream-position ((stream trivial-gray-stream-mixin) position)
(if position
Revision: 4371
Author: hans
URL: http://bknr.net/trac/changeset/4371
update from upstream
U trunk/thirdparty/cl+ssl/CVS/Entries
U trunk/thirdparty/cl+ssl/example.lisp
U trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp
U trunk/thirdparty/cl+ssl/ffi.lisp
U trunk/thirdparty/cl+ssl/index.html
U trunk/thirdparty/cl+ssl/package.lisp
U trunk/thirdparty/cl+ssl/streams.lisp
Modified: trunk/thirdparty/cl+ssl/CVS/Entries
===================================================================
--- trunk/thirdparty/cl+ssl/CVS/Entries 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/CVS/Entries 2009-04-09 05:57:32 UTC (rev 4371)
@@ -1,17 +1,17 @@
-/LICENSE/1.4/Mon Jun 23 13:16:26 2008//
-/Makefile/1.1.1.1/Mon Jun 23 13:16:26 2008//
-/bio.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/cl+ssl.asd/1.6/Mon Jun 23 13:16:26 2008//
-/conditions.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/example.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer-all.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer-clisp.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi.lisp/1.8/Mon Jun 23 13:16:26 2008//
-/index.css/1.2/Mon Jun 23 13:16:26 2008//
-/index.html/1.15/Mon Jun 23 13:16:26 2008//
-/package.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/reload.lisp/1.5/Mon Jun 23 13:16:26 2008//
-/test.lisp/1.4/Mon Jun 23 13:16:26 2008//
-/streams.lisp/1.13/Mon Oct 27 10:03:01 2008//
+/LICENSE/1.4/Fri Jan 23 19:29:58 2009//
+/Makefile/1.1.1.1/Fri Jan 23 19:29:58 2009//
+/bio.lisp/1.3/Fri Jan 23 19:29:58 2009//
+/cl+ssl.asd/1.6/Fri Jan 23 19:29:58 2009//
+/conditions.lisp/1.3/Fri Jan 23 19:29:58 2009//
+/ffi-buffer-all.lisp/1.1/Fri Jan 23 19:29:58 2009//
+/ffi-buffer.lisp/1.1/Fri Jan 23 19:29:58 2009//
+/index.css/1.2/Fri Jan 23 19:29:58 2009//
+/reload.lisp/1.5/Fri Jan 23 19:29:58 2009//
+/test.lisp/1.4/Fri Jan 23 19:29:58 2009//
+/example.lisp/1.5/Thu Apr 9 05:57:19 2009//
+/ffi-buffer-clisp.lisp/1.2/Thu Apr 9 05:57:19 2009//
+/ffi.lisp/1.12/Thu Apr 9 05:57:19 2009//
+/index.html/1.24/Thu Apr 9 05:57:19 2009//
+/package.lisp/1.5/Thu Apr 9 05:57:19 2009//
+/streams.lisp/1.16/Thu Apr 9 05:57:19 2009//
D
Modified: trunk/thirdparty/cl+ssl/example.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/example.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/example.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -33,7 +33,7 @@
(defun test-nntps-client (&optional (host "snews.gmane.org") (port 563))
(let* ((fd (trivial-sockets:open-stream host port
:element-type '(unsigned-byte 8)))
- (nntps (cl+ssl:make-ssl-client-stream fd :external-format :iso-8859-1)))
+ (nntps (cl+ssl:make-ssl-client-stream fd :external-format '(:iso-8859-1 :eol-style :lf))))
(format t "NNTPS> ~A~%" (read-line-crlf nntps))
(write-line "HELP" nntps)
(force-output nntps)
@@ -60,7 +60,7 @@
(cl+ssl:make-ssl-client-stream
socket
:unwrap-stream-p t
- :external-format :iso-8859-1))))
+ :external-format '(:iso-8859-1 :eol-style :lf)))))
(unwind-protect
(progn
(format https "GET / HTTP/1.0~%Host: ~a~%~%" host)
@@ -68,8 +68,7 @@
(loop :for line = (read-line-crlf https nil)
:while line :do
(format t "HTTPS> ~a~%" line)))
- (close socket)
- (close https))))
+ (close https))))
;; start a simple HTTPS server. See the mod_ssl documentation at
;; <URL:http://www.modssl.org/> for information on generating the
@@ -90,8 +89,8 @@
server
:element-type '(unsigned-byte 8)))
(client (cl+ssl:make-ssl-server-stream
- (cl+ssl:stream-fd socket)
- :external-format :iso-8859-1
+ socket
+ :external-format '(:iso-8859-1 :eol-style :lf)
:certificate cert
:key key)))
(unwind-protect
@@ -108,5 +107,4 @@
(format client "CL+SSL running in ~A ~A~%"
(lisp-implementation-type)
(lisp-implementation-version)))
- (close socket)
(close client))))))
Modified: trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -13,13 +13,27 @@
(setf (ffi:memory-as buf 'ffi:uint8 index) val))
(defsetf buffer-elt set-buffer-elt)
-(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) (end2 +initial-buffer-size+))
+(declaim
+ (inline calc-buf-end))
+
+;; to calculate non NIL value of the buffer end index
+(defun calc-buf-end (buf-start vec vec-start vec-end)
+ (+ buf-start
+ (- (or vec-end (length vec))
+ vec-start)))
+
+(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) end2)
+ (when (null end2)
+ (setf end2 (calc-buf-end start2 vec start1 end1)))
(replace
vec
(ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end2 start2))) start2)
:start1 start1
:end1 end1))
-(defun b/v-replace (buf vec &key (start1 0) (end1 +initial-buffer-size+) (start2 0) end2)
+
+(defun b/v-replace (buf vec &key (start1 0) end1 (start2 0) end2)
+ (when (null end1)
+ (setf end1 (calc-buf-end start1 vec start2 end2)))
(setf
(ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end1 start1))) start1)
(subseq vec start2 end2)))
Modified: trunk/thirdparty/cl+ssl/ffi.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/ffi.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/ffi.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -25,8 +25,6 @@
;;; Constants
;;;
-(defconstant +random-entropy+ 256)
-
(defconstant +ssl-filetype-pem+ 1)
(defconstant +ssl-filetype-asn1+ 2)
(defconstant +ssl-filetype-default+ 3)
@@ -176,6 +174,10 @@
(ssl ssl-pointer)
(str :string)
(type :int))
+(cffi:defcfun ("SSL_CTX_use_certificate_chain_file" ssl-ctx-use-certificate-chain-file)
+ :int
+ (ctx ssl-ctx)
+ (str :string))
(cffi:defcfun ("SSL_CTX_load_verify_locations" ssl-ctx-load-verify-locations)
:int
(ctx ssl-ctx)
@@ -196,6 +198,10 @@
(larg :long)
(parg :long))
+(cffi:defcfun ("SSL_CTX_set_default_passwd_cb" ssl-ctx-set-default-passwd-cb)
+ :void
+ (ctx ssl-ctx)
+ (pem_passwd_cb :pointer))
;;; Funcall wrapper
;;;
@@ -303,36 +309,93 @@
(warn "non-blocking stream encountered unexpectedly"))
+;;; Encrypted PEM files support
+;;;
+
+;; based on http://www.openssl.org/docs/ssl/SSL_CTX_set_default_passwd_cb.html
+
+(defvar *pem-password* ""
+ "The callback registered with SSL_CTX_set_default_passwd_cb
+will use this value.")
+
+;; The callback itself
+(cffi:defcallback pem-password-callback :int
+ ((buf :pointer) (size :int) (rwflag :int) (unused :pointer))
+ (let* ((password-str (coerce *pem-password* 'base-string))
+ (tmp (cffi:foreign-string-alloc password-str)))
+ (cffi:foreign-funcall "strncpy"
+ :pointer buf
+ :pointer tmp
+ :int size)
+ (cffi:foreign-string-free tmp)
+ (setf (cffi:mem-ref buf :char (1- size)) 0)
+ (cffi:foreign-funcall "strlen" :pointer buf :int)))
+
+;; The macro to be used by other code to provide password
+;; when loading PEM file.
+(defmacro with-pem-password ((password) &body body)
+ `(let ((*pem-password* (or ,password "")))
+ ,@body))
+
+
;;; Initialization
;;;
-(defun init-prng ()
- ;; this initialization of random entropy is not necessary on
- ;; Linux, since the OpenSSL library automatically reads from
- ;; /dev/urandom if it exists. On Solaris it is necessary.
- (let ((buf (cffi-sys::make-shareable-byte-vector +random-entropy+)))
- (dotimes (i +random-entropy+)
- (setf (elt buf i) (random 256)))
+
+(defun init-prng (seed-byte-sequence)
+ (let* ((length (length seed-byte-sequence))
+ (buf (cffi-sys::make-shareable-byte-vector length)))
+ (dotimes (i length)
+ (setf (elt buf i) (elt seed-byte-sequence i)))
(cffi-sys::with-pointer-to-vector-data (ptr buf)
- (rand-seed ptr +random-entropy+))))
+ (rand-seed ptr length))))
(defun ssl-ctx-set-session-cache-mode (ctx mode)
(ssl-ctx-ctrl ctx +SSL_CTRL_SET_SESS_CACHE_MODE+ mode 0))
-(defun initialize (&optional (method 'ssl-v23-method))
+(defun initialize (&key (method 'ssl-v23-method) rand-seed)
(setf *bio-lisp-method* (make-bio-lisp-method))
(ssl-load-error-strings)
(ssl-library-init)
- (init-prng)
+ (when rand-seed
+ (init-prng rand-seed))
(setf *ssl-global-method* (funcall method))
(setf *ssl-global-context* (ssl-ctx-new *ssl-global-method*))
- (ssl-ctx-set-session-cache-mode *ssl-global-context* 3))
+ (ssl-ctx-set-session-cache-mode *ssl-global-context* 3)
+ (ssl-ctx-set-default-passwd-cb *ssl-global-context*
+ (cffi:callback pem-password-callback)))
-(defun ensure-initialized (&optional (method 'ssl-v23-method))
+(defun ensure-initialized (&key (method 'ssl-v23-method) (rand-seed nil))
+ "In most cases you do *not* need to call this function, because it
+is called automatically by all other functions. The only reason to
+call it explicitly is to supply the RAND-SEED parameter. In this case
+do it before calling any other functions.
+
+Just leave the default value for the METHOD parameter.
+
+RAND-SEED is an octet sequence to initialize OpenSSL random number generator.
+On many platforms, including Linux and Windows, it may be leaved NIL (default),
+because OpenSSL initializes the random number generator from OS specific service.
+But for example on Solaris it may be necessary to supply this value.
+The minimum length required by OpenSSL is 128 bits.
+See ttp://www.openssl.org/support/faq.html#USER1 for details.
+
+Hint: do not use Common Lisp RANDOM function to generate the RAND-SEED,
+because the function usually returns predictable values."
(unless (ssl-initialized-p)
- (initialize method))
+ (initialize :method method :rand-seed rand-seed))
(unless *bio-lisp-method*
(setf *bio-lisp-method* (make-bio-lisp-method))))
+(defun use-certificate-chain-file (certificate-chain-file)
+ "Loads a PEM encoded certificate chain file CERTIFICATE-CHAIN-FILE
+and adds the chain to global context. The certificates must be sorted
+starting with the subject's certificate (actual client or server certificate),
+followed by intermediate CA certificates if applicable, and ending at
+the highest level (root) CA. Note: the RELOAD function clears the global
+context and in particular the loaded certificate chain."
+ (ensure-initialized)
+ (ssl-ctx-use-certificate-chain-file *ssl-global-context* certificate-chain-file))
+
(defun reload ()
(cffi:load-foreign-library 'libssl)
(cffi:load-foreign-library 'libeay32)
Modified: trunk/thirdparty/cl+ssl/index.html
===================================================================
--- trunk/thirdparty/cl+ssl/index.html 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/index.html 2009-04-09 05:57:32 UTC (rev 4371)
@@ -34,7 +34,7 @@
<p>
Anonymous CVS (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-plus-ssl">browse</a>):
</p>
- <pre>$ cvs -d :pserver:anonymous:anonymous@common-lisp.net:/project/cl-plus-ssl/cvsroot cl+ssl</pre>
+ <pre>$ cvs -z3 -d :pserver:anonymous:anonymous@common-lisp.net:/project/cl-plus-ssl/cvsroot co cl+ssl</pre>
<p>
<a
href="http://common-lisp.net/project/cl-plus-ssl/download/">Tarballs</a>
@@ -94,8 +94,32 @@
<h3>API functions</h3>
<p>
- <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key close-callback (unwrap-streams-p t))<br/><br/>
- Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key close-callback (unwrap-streams-p t))</div>
+ <div class="def">Function CL+SSL:ENSURE-INITIALIZED (&key (method 'ssl-v23-method) (rand-seed nil))</div>
+ In most cases you <strong>do not</strong> need to call this function, because it is called
+ automatically. The only reason to call it explicitly is to supply the <tt>rand-seed</tt> parameter.
+ In this case do it before calling any other functions.
+ </p>
+ <p>
+ Keyword arguments:
+ </p>
+ <p>
+ <tt>method</tt>. Just leave its default value.
+ </p>
+ <p>
+ <tt>rand-seed</tt> is an octet sequence to initialize OpenSSL random number generator.
+ On many platforms, including Linux and Windows, it may be leaved NIL (default),
+ because OpenSSL initializes the random number generator from OS specific service. But for
+ example on Solaris it may be necessary to supply this value. The minimum length required
+ by OpenSSL is 128 bits. See here <a href="http://www.openssl.org/support/faq.html#USER1">
+ http://www.openssl.org/support/faq.html#USER1</a> for the details.
+ </p>
+ <p>
+ Hint: do not use Common Lisp RANDOM function to generate the <tt>rand-seed</tt>, because the function
+ usually returns predictable values.
+ </p>
+ <p>
+ <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-streams-p t))<br/><br/>
+ Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-streams-p t))</div>
Return an SSL stream for the client (server)
socket <tt>fd-or-stream</tt>. All reads and writes to this
stream will be pushed through the OpenSSL library.
@@ -121,10 +145,13 @@
</p>
<p>
<tt>certificate</tt> is the path to a file containing the PEM-encoded
- certificate for your client. <tt>key</tt> is the path to the PEM-encoded
- key for the client, which must not be associated with a passphrase.
+ certificate.
</p>
<p>
+ <tt>key</tt> is the path to the PEM-encoded key, which may be associated
+ with the passphrase <tt>password</tt>.
+ </p>
+ <p>
If <tt>external-format</tt> is <tt>nil</tt> (the default), a plain
<tt>(unsigned-byte 8)</tt> SSL stream is returned. With a
non-null <tt>external-format</tt>, a flexi-stream capable of
@@ -132,6 +159,18 @@
as its initial external format.
</p>
<p>
+ <div class="def">Function CL+SSL:USE-CERTIFICATE-CHAIN-FILE (certificate-chain-file)</div>
+ Loads a PEM encoded certificate chain file <tt>certificate-chain-file</tt>
+ and adds the chain to global context. The certificates must be sorted
+ starting with the subject's certificate (actual client or server certificate),
+ followed by intermediate CA certificates if applicable, and ending at
+ the highest level (root) CA.
+ </p>
+ <p>
+ Note: the RELOAD function clears the global
+ context and in particular the loaded certificate chain.
+ </p>
+ <p>
<div class="def">Function CL+SSL:RELOAD ()</div>
Reload <tt>libssl</tt>. Call this function after restarting a Lisp
core with CL+SSL dumped into it on Lisp implementations that do
@@ -194,13 +233,25 @@
<li>
Support for I/O deadlines (Clozure CL and SBCL).
</li>
+ <li>
+ Support for encrypted keys, thanks to Vsevolod Dyomkin.
+ </li>
+ <li>
+ Chained certificates support, thanks to Juhani Ränkimies.
+ </li>
+ <li>
+ More secure initialization of OpenSSL random number generator.
+ </li>
+ <li>
+ Minor CLISP-specific fixes.
+ </li>
</ul>
<p>
2007-xx-yy
</p>
<ul>
<li>
- Fixed windows support, thanks to Matthew Kennedy and Vodonosov Anton.
+ Fixed windows support, thanks to Matthew Kennedy and Anton Vodonosov.
</li>
</ul>
<p>
@@ -208,7 +259,7 @@
</p>
<ul>
<li>
- Improved clisp support, thanks
+ Improved CLISP support, thanks
to <a
href="http://web.kepibu.org/code/lisp/cl+ssl/">Pixel
// pinterface</a>, as well as client certificate support.
Modified: trunk/thirdparty/cl+ssl/package.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/package.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/package.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -10,6 +10,7 @@
(:use :common-lisp :trivial-gray-streams)
(:export #:ensure-initialized
#:reload
- #:stream-fd
- #:make-ssl-client-stream
- #:make-ssl-server-stream))
+ #:stream-fd
+ #:make-ssl-client-stream
+ #:make-ssl-server-stream
+ #:use-certificate-chain-file))
Modified: trunk/thirdparty/cl+ssl/streams.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/streams.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/streams.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -165,8 +165,14 @@
#+clozure-common-lisp
(defun install-nonblock-flag (fd)
- (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd) #$O_NONBLOCK)))
-
+ (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd)
+ #.(read-from-string "#$O_NONBLOCK"))))
+ ;; read-from-string is necessary because
+ ;; CLISP and perhaps other Lisps are confused
+ ;; by #$, signaling"undefined dispatch character $",
+ ;; even though the defun in conditionalized by
+ ;; #+clozure-common-lisp
+
#+(and sbcl (not win32))
(defun install-nonblock-flag (fd)
(sb-posix:fcntl fd
@@ -220,32 +226,33 @@
;; fixme: free the context when errors happen in this function
(defun make-ssl-client-stream
- (socket &key certificate key (method 'ssl-v23-method) external-format
+ (socket &key certificate key password (method 'ssl-v23-method) external-format
close-callback (unwrap-stream-p t))
"Returns an SSL stream for the client socket descriptor SOCKET.
CERTIFICATE is the path to a file containing the PEM-encoded certificate for
your client. KEY is the path to the PEM-encoded key for the client, which
-must not be associated with a passphrase."
- (ensure-initialized method)
+may be associated with the passphrase PASSWORD."
+ (ensure-initialized :method method)
(let ((stream (make-instance 'ssl-stream
:socket socket
:close-callback close-callback))
(handle (ssl-new *ssl-global-context*)))
(setf socket (install-handle-and-bio stream handle socket unwrap-stream-p))
(ssl-set-connect-state handle)
- (install-key-and-cert handle key certificate)
+ (with-pem-password (password)
+ (install-key-and-cert handle key certificate))
(ensure-ssl-funcall stream handle #'ssl-connect handle)
(handle-external-format stream external-format)))
;; fixme: free the context when errors happen in this function
(defun make-ssl-server-stream
- (socket &key certificate key (method 'ssl-v23-method) external-format
+ (socket &key certificate key password (method 'ssl-v23-method) external-format
close-callback (unwrap-stream-p t))
"Returns an SSL stream for the server socket descriptor SOCKET.
CERTIFICATE is the path to a file containing the PEM-encoded certificate for
your server. KEY is the path to the PEM-encoded key for the server, which
-must not be associated with a passphrase."
- (ensure-initialized method)
+may be associated with the passphrase PASSWORD."
+ (ensure-initialized :method method)
(let ((stream (make-instance 'ssl-server-stream
:socket socket
:close-callback close-callback
@@ -256,7 +263,8 @@
(ssl-set-accept-state handle)
(when (zerop (ssl-set-cipher-list handle "ALL"))
(error 'ssl-error-initialize :reason "Can't set SSL cipher list"))
- (install-key-and-cert handle key certificate)
+ (with-pem-password (password)
+ (install-key-and-cert handle key certificate))
(ensure-ssl-funcall stream handle #'ssl-accept handle)
(handle-external-format stream external-format)))
Revision: 4370
Author: dverna
URL: http://bknr.net/trac/changeset/4370
Update the call for papers, but notify extension
U trunk/projects/lisp-ecoop/website/templates/cfp.xml
Modified: trunk/projects/lisp-ecoop/website/templates/cfp.xml
===================================================================
--- trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-04-08 16:21:48 UTC (rev 4369)
+++ trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-04-08 16:23:39 UTC (rev 4370)
@@ -11,7 +11,7 @@
Important Dates
===============
-Submission deadline: April 22, 2009
+Submission deadline: April 22, 2009 (EXTENDED)
Notification of acceptance: May 08, 2009
ECOOP early registration deadline: May 20, 2009
6th European Lisp Workshop: July 06, 2009
Revision: 4369
Author: dverna
URL: http://bknr.net/trac/changeset/4369
Update the call for papers
U trunk/projects/lisp-ecoop/website/templates/cfp.xml
Modified: trunk/projects/lisp-ecoop/website/templates/cfp.xml
===================================================================
--- trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-04-08 16:14:47 UTC (rev 4368)
+++ trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-04-08 16:21:48 UTC (rev 4369)
@@ -11,7 +11,7 @@
Important Dates
===============
-Submission deadline: April 08, 2009
+Submission deadline: April 22, 2009
Notification of acceptance: May 08, 2009
ECOOP early registration deadline: May 20, 2009
6th European Lisp Workshop: July 06, 2009
Revision: 4366
Author: dverna
URL: http://bknr.net/trac/changeset/4366
Deadline extension
U trunk/projects/lisp-ecoop/website/templates/home.xml
U trunk/projects/lisp-ecoop/website/templates/news.xml
Modified: trunk/projects/lisp-ecoop/website/templates/home.xml
===================================================================
--- trunk/projects/lisp-ecoop/website/templates/home.xml 2009-04-07 11:47:42 UTC (rev 4365)
+++ trunk/projects/lisp-ecoop/website/templates/home.xml 2009-04-08 16:09:09 UTC (rev 4366)
@@ -33,6 +33,7 @@
<h2>Important News</h2>
<ul>
+ <li>The submission deadline has been extended to April 22nd</li>
<li>
This year, and for the first time, the workshop proceedings will be
published in the ACM Digital Library.
@@ -75,7 +76,9 @@
<h2>Important Dates</h2>
<ul>
-<li>Submission deadline: <b>April 08, 2009</b></li>
+<li>
+ Submission deadline <span style="color: red;">EXTENDED</span>:
+ <b>April 22, 2009</b></li>
<li>Notification of acceptance: <b>May 08, 2009</b></li>
<li>ECOOP early registration deadline: <b>May 20, 2009</b></li>
</ul>
Modified: trunk/projects/lisp-ecoop/website/templates/news.xml
===================================================================
--- trunk/projects/lisp-ecoop/website/templates/news.xml 2009-04-07 11:47:42 UTC (rev 4365)
+++ trunk/projects/lisp-ecoop/website/templates/news.xml 2009-04-08 16:09:09 UTC (rev 4366)
@@ -35,6 +35,14 @@
</ul>
-->
+<h3>April 8th, 2009</h3>
+<ul>
+ <li>
+ Upon request from potential contributors, the deadline for submissions has
+ been extended. You now have until April 22nd.
+ </li>
+</ul>
+
<h3>February 23, 2009</h3>
<ul>
<li>
Revision: 4365
Author: hans
URL: http://bknr.net/trac/changeset/4365
documentation
A trunk/projects/symbolics-keyboard/teensy-firmware/README.txt
U trunk/projects/symbolics-keyboard/teensy-firmware/symbolics.c
Added: trunk/projects/symbolics-keyboard/teensy-firmware/README.txt
===================================================================
--- trunk/projects/symbolics-keyboard/teensy-firmware/README.txt (rev 0)
+++ trunk/projects/symbolics-keyboard/teensy-firmware/README.txt 2009-04-07 11:47:42 UTC (rev 4365)
@@ -0,0 +1,53 @@
+Symbolics keyboard adapter, based on Teensy keyboard example.
+
+The Symbolics keyboard acts as a shift register with 128 bits. Each
+key is represented by one bit in the shift register. The hardware
+interface consists of a clear line which is used to signal the
+beginning of a read cycle, a clock line, and a data line. All signals
+are active low. The keyboard changes the data line on the rising edge
+of the clock. It should be read near the falling edge of the clock by
+the host.
+
+The keyboard needs to be interfaced to the Teensy board as
+follows. The wire colors specified are those used in the original
+modular cable supplied with the keyboard:
+
+blue 5V
+green GND
+red D4 DIN
+black D5 CLK
+white D6 CLR
+
+The keyboard implements two locking functions, caps lock and mode
+lock. Both of these are implemented as switches, not as buttons.
+Host systems do not usually expect switches on keyboards, so
+precautions must be taken to synchronize their state to the host's
+state.
+
+The "Caps Lock" key is implemented so that it works as usual, i.e. it
+is transmitted to the host as if it were a button. The host sends
+back its caps lock state through the keyboard LEDs. Thus, the
+controller firmware can synchronize the host's state with the state of
+the caps lock switch on the keyboard.
+
+The "Mode Lock" key is used to switch the keyboard between the classic
+Symbolics layout and a variant that assigns the modifier keys on the
+right side of the space bar to be cursor keys. This mode is called
+f_mode.
+
+The "Local" key is used as a modifier key to trigger functions in the
+converter firmware. The following functions are implemented:
+
+Local-B boots the AVR into the boot loader so that it can be
+reprogrammed through USB by the host.
+
+Local-V sends the Subversion revision number of this file to the host.
+
+Mapping of the symbolics key number to an USB key number is done
+through the mapping table defined in the file keymap.inc. There are
+two separate tables, one for normal mode and one for f_mode. The
+mapping table is normally autogenerated by the keymap generation
+program contained in make-keymap.lisp, but it can be manually edited
+if no Lisp evironment is available.
+
+Author: Hans Huebner (hans.huebner(a)gmail.com).
Property changes on: trunk/projects/symbolics-keyboard/teensy-firmware/README.txt
___________________________________________________________________
Name: svn:executable
+ *
Modified: trunk/projects/symbolics-keyboard/teensy-firmware/symbolics.c
===================================================================
--- trunk/projects/symbolics-keyboard/teensy-firmware/symbolics.c 2009-04-07 10:56:59 UTC (rev 4364)
+++ trunk/projects/symbolics-keyboard/teensy-firmware/symbolics.c 2009-04-07 11:47:42 UTC (rev 4365)
@@ -1,29 +1,16 @@
// -*- C++ -*- (this is really C)
-// Symbolics keyboard adapter, based on Teensy keyboard example.
+// -*- C++ -*-
-// The Symbolics keyboard acts as a shift register with 128 bits. The
-// hardware interface consists of a clear line which is used to signal
-// the beginning of a read cycle, a clock line, and a data line. All
-// signals are active low. The keyboard changes the data line on the
-// rising edge of the clock. It should be read near the falling edge
-// of the clock by the host.
+// Symbolics keyboard to USB adapter
-// The keyboard needs to be interfaced to the Teensy board as
-// follows. The wire colors specified are those used in the original
-// modular cable supplied with the keyboard:
-//
-// blue 5V
-// green GND
-// red D4 DIN
-// black D5 CLK
-// white D6 CLR
+// See the README.txt file for documentation
-// The keyboard implements two locking functions, caps lock and mode
-// lock. Both of these are implemented as switches, not as buttons,
-// so precautions must be made to synchronize their state to the
-// host's caps lock state.
+// Copyright 2009 by Hans Huebner (hans.huebner(a)gmail.com).
+// Additional copyrights apply.
+// This is the original copyright notice for this file:
+
/* Keyboard example for Teensy USB Development Board
* http://www.pjrc.com/teensy/usb_keyboard.html
* Copyright (c) 2008 PJRC.COM, LLC
@@ -87,6 +74,8 @@
void
init_keyboard_interface(void)
{
+ // Initialize I/O ports used to interface to the keyboard
+
DDRD = MASK_CLOCK | MASK_CLEAR;
PORTD = MASK_CLOCK | MASK_CLEAR | MASK_DIN;
}
@@ -94,30 +83,34 @@
void
poll_keyboard(uint8_t* state)
{
- PORTD &= ~MASK_CLEAR;
- _delay_us(10);
- PORTD |= MASK_CLEAR;
- _delay_us(100);
- for (int i = 0; i < 16; i++) {
- uint8_t buf = 0;
- for (int j = 0; j < 8; j++) {
- buf >>= 1;
- PORTD &= ~MASK_CLOCK;
- _delay_us(10);
- PORTD |= MASK_CLOCK;
- _delay_us(40);
- if (!(PIND & MASK_DIN)) {
- buf |= 0x80;
- }
+ // Read the keyboard shift register into the memory region pointed
+ // to by state.
+
+ PORTD &= ~MASK_CLEAR;
+ _delay_us(10);
+ PORTD |= MASK_CLEAR;
+ _delay_us(100);
+ for (int i = 0; i < 16; i++) {
+ uint8_t buf = 0;
+ for (int j = 0; j < 8; j++) {
+ buf >>= 1;
+ PORTD &= ~MASK_CLOCK;
+ _delay_us(10);
+ PORTD |= MASK_CLOCK;
+ _delay_us(40);
+ if (!(PIND & MASK_DIN)) {
+ buf |= 0x80;
}
- state[i] = buf;
}
+ state[i] = buf;
+ }
}
void
jump_to_loader(void)
{
// Jump to the HalfKay (or any other) boot loader
+
USBCON = 0;
asm("jmp 0x3000");
}
@@ -159,9 +152,11 @@
// Evaluate key press.
switch (keyboard_keys[0]) {
+
case KEY_B:
jump_to_loader();
break;
+
case KEY_V:
report_version();
break;
@@ -171,8 +166,8 @@
void
send_keys(uint8_t* state)
{
- // A change of state has been detected by the main loop, report all
- // currently pressed keys to the host.
+ // Report all currently pressed keys to the host. This function
+ // will be called when a change of state has been detected.
uint8_t local = 0;
uint8_t caps_lock_pressed = 0;
Revision: 4364
Author: hans
URL: http://bknr.net/trac/changeset/4364
Add WITHIN-REQUEST-P function that can be used to check whether a request is processed within the current dynamic context. Provided by Mark David, ITA
U trunk/thirdparty/hunchentoot/doc/index.xml
U trunk/thirdparty/hunchentoot/packages.lisp
U trunk/thirdparty/hunchentoot/request.lisp
U trunk/thirdparty/hunchentoot/specials.lisp
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2009-04-07 07:22:30 UTC (rev 4363)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-04-07 10:56:59 UTC (rev 4364)
@@ -2854,6 +2854,15 @@
</clix:function>
<clix:special-variable name="*tmp-directory*">
+ <clix:function name='within-request-p'>
+ <clix:lambda-list>
+ </clix:lambda-list>
+ <clix:returns>generalized-boolean
+ </clix:returns>
+ <clix:description>Returns true if in the context of a request. Otherwise, <code>NIL</code>.
+ </clix:description>
+ </clix:function>
+
<clix:description>
This should be a pathname denoting a directory where temporary
files can be stored. It is used for <a href="#upload">file
Modified: trunk/thirdparty/hunchentoot/packages.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/packages.lisp 2009-04-07 07:22:30 UTC (rev 4363)
+++ trunk/thirdparty/hunchentoot/packages.lisp 2009-04-07 10:56:59 UTC (rev 4364)
@@ -64,6 +64,7 @@
"*METHODS-FOR-POST-PARAMETERS*"
"*REPLY*"
"*REQUEST*"
+ "WITHIN-REQUEST-P"
"*REWRITE-FOR-SESSION-URLS*"
"*SESSION*"
"*SESSION-GC-FREQUENCY*"
Modified: trunk/thirdparty/hunchentoot/request.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/request.lisp 2009-04-07 07:22:30 UTC (rev 4363)
+++ trunk/thirdparty/hunchentoot/request.lisp 2009-04-07 10:56:59 UTC (rev 4364)
@@ -217,7 +217,8 @@
(let (*tmp-files* *headers-sent*)
(unwind-protect
(with-mapped-conditions ()
- (let* ((*request* request))
+ (let* ((*request* request)
+ (*within-request-p* t))
(multiple-value-bind (body error)
(catch 'handler-done
(handler-bind ((error
@@ -255,6 +256,10 @@
(ignore-errors
(delete-file path)))))))
+(defun within-request-p ()
+ "True if we're in the context of a request, otherwise nil."
+ *within-request-p*)
+
(defun parse-multipart-form-data (request external-format)
"Parse the REQUEST body as multipart/form-data, assuming that its
content type has already been verified. Returns the form data as
Modified: trunk/thirdparty/hunchentoot/specials.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/specials.lisp 2009-04-07 07:22:30 UTC (rev 4363)
+++ trunk/thirdparty/hunchentoot/specials.lisp 2009-04-07 10:56:59 UTC (rev 4364)
@@ -234,6 +234,11 @@
(defvar-unbound *request*
"The current REQUEST object while in the context of a request.")
+(defvar *within-request-p* nil
+ "True while in the context of a request (while *request* is bound),
+otherwise nil. Outside callers should use exported function
+within-request-p to test this.")
+
(defvar-unbound *reply*
"The current REPLY object while in the context of a request.")