From bknr at bknr.net Thu Feb 5 11:59:50 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 05 Feb 2009 12:59:50 +0100 Subject: [bknr-cvs] hans changed trunk/libraries/yason/encode.lisp Message-ID: Revision: 4185 Author: hans URL: http://bknr.net/trac/changeset/4185 Fix bug introduced by recent patch received. U trunk/libraries/yason/encode.lisp Modified: trunk/libraries/yason/encode.lisp =================================================================== --- trunk/libraries/yason/encode.lisp 2009-01-30 15:57:00 UTC (rev 4184) +++ trunk/libraries/yason/encode.lisp 2009-02-05 11:59:49 UTC (rev 4185) @@ -53,7 +53,7 @@ (princ object stream)) (defun encode-key/value (key value stream) - (encode string stream) + (encode key stream) (write-char #\: stream) (encode value stream)) From bknr at bknr.net Thu Feb 5 12:00:31 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 05 Feb 2009 13:00:31 +0100 Subject: [bknr-cvs] hans changed trunk/bknr/datastore/src/bknr.datastore.asd Message-ID: Revision: 4186 Author: hans URL: http://bknr.net/trac/changeset/4186 Add :sb-posix dependency to appease (older?) sbcl's. Thanks to Erik Winkels for reporting. U trunk/bknr/datastore/src/bknr.datastore.asd Modified: trunk/bknr/datastore/src/bknr.datastore.asd =================================================================== --- trunk/bknr/datastore/src/bknr.datastore.asd 2009-02-05 11:59:49 UTC (rev 4185) +++ trunk/bknr/datastore/src/bknr.datastore.asd 2009-02-05 12:00:31 UTC (rev 4186) @@ -23,7 +23,8 @@ :bknr.utils :bknr.indices :yason - :trivial-utf-8) + :trivial-utf-8 + #+sbcl :sb-posix) :components ((:module "data" :components ((:file "package") (:file "encoding" :depends-on ("package")) From bknr at bknr.net Mon Feb 9 07:52:58 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 08:52:58 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4189 Author: edi URL: http://bknr.net/trac/changeset/4189 Happy New Year U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/drakma.asd U trunk/thirdparty/drakma/packages.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/request.lisp U trunk/thirdparty/drakma/specials.lisp U trunk/thirdparty/drakma/util.lisp Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/cookies.lisp,v 1.15 2008/01/14 01:57:01 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/drakma.asd =================================================================== --- trunk/thirdparty/drakma/drakma.asd 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/drakma.asd 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/drakma.asd,v 1.49 2008/05/24 03:21:22 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/packages.lisp,v 1.22 2008/01/14 01:57:01 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/read.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/read.lisp,v 1.17 2008/05/25 11:35:20 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/request.lisp,v 1.58 2008/05/30 11:30:45 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/specials.lisp =================================================================== --- trunk/thirdparty/drakma/specials.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/specials.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/specials.lisp,v 1.19 2008/01/14 01:57:02 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-02-09 07:52:10 UTC (rev 4188) +++ trunk/thirdparty/drakma/util.lisp 2009-02-09 07:52:58 UTC (rev 4189) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/drakma/util.lisp,v 1.36 2008/05/30 11:30:45 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions From bknr at bknr.net Mon Feb 9 07:50:26 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 08:50:26 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4187 Author: edi URL: http://bknr.net/trac/changeset/4187 Happy New Year U trunk/thirdparty/hunchentoot/conditions.lisp U trunk/thirdparty/hunchentoot/connection-manager.lisp U trunk/thirdparty/hunchentoot/cookie.lisp U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/get-backtrace.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/hunchentoot-test.asd U trunk/thirdparty/hunchentoot/hunchentoot.asd U trunk/thirdparty/hunchentoot/lispworks.lisp U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/mime-types.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/reply.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/server.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/set-timeouts.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/ssl.lisp U trunk/thirdparty/hunchentoot/test/packages.lisp U trunk/thirdparty/hunchentoot/test/test.lisp U trunk/thirdparty/hunchentoot/unix-acl.lisp U trunk/thirdparty/hunchentoot/unix-cmu.lisp U trunk/thirdparty/hunchentoot/unix-lw.lisp U trunk/thirdparty/hunchentoot/unix-mcl.lisp U trunk/thirdparty/hunchentoot/unix-sbcl.lisp U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/conditions.lisp =================================================================== --- trunk/thirdparty/hunchentoot/conditions.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/conditions.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: ODD-STREAMS; Base: 10 -*- +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/odd-streams/conditions.lisp,v 1.5 2007/12/31 01:08:45 edi Exp $ -;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2008-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- ;;; $Header$ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/cookie.lisp =================================================================== --- trunk/thirdparty/hunchentoot/cookie.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/cookie.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/cookie.lisp,v 1.8 2008/02/13 16:02:17 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/easy-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/easy-handlers.lisp,v 1.13 2008/02/13 16:02:17 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/get-backtrace.lisp =================================================================== --- trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/port-cmu.lisp,v 1.12 2008/04/08 14:39:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/headers.lisp,v 1.29 2008/03/27 08:08:31 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/hunchentoot-test.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot-test.asd 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/hunchentoot-test.asd 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/hunchentoot-test.asd,v 1.3 2008/02/13 16:02:17 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/hunchentoot.asd,v 1.61 2008/04/09 08:17:48 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/lispworks.lisp =================================================================== --- trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/port-lw.lisp,v 1.14 2008/04/08 14:39:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/log.lisp =================================================================== --- trunk/thirdparty/hunchentoot/log.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/log.lisp,v 1.10 2008/02/13 16:02:17 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/mime-types.lisp =================================================================== --- trunk/thirdparty/hunchentoot/mime-types.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/mime-types.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/mime-types.lisp,v 1.4 2008/02/13 16:02:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/misc.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/misc.lisp,v 1.17 2008/03/17 11:40:25 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/packages.lisp,v 1.34 2008/02/13 16:02:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/reply.lisp =================================================================== --- trunk/thirdparty/hunchentoot/reply.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/reply.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/reply.lisp,v 1.20 2008/02/13 16:02:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/request.lisp,v 1.35 2008/02/13 16:02:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/server.lisp,v 1.43 2008/04/09 08:17:48 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/session.lisp,v 1.12 2008/02/13 16:02:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/set-timeouts.lisp =================================================================== --- trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/server.lisp,v 1.43 2008/04/09 08:17:48 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/specials.lisp,v 1.33 2008/04/08 14:39:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header$ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/test/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/packages.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/test/packages.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/test/packages.lisp,v 1.5 2008/02/13 16:02:22 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/test/test.lisp,v 1.24 2008/03/06 07:46:53 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/unix-acl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-acl.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/unix-acl.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/unix-acl.lisp,v 1.6 2008/02/13 16:02:19 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/unix-cmu.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-cmu.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/unix-cmu.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/unix-cmu.lisp,v 1.6 2008/02/13 16:02:19 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/unix-lw.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-lw.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/unix-lw.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/unix-lw.lisp,v 1.5 2008/02/13 16:02:19 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/unix-mcl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-mcl.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/unix-mcl.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/unix-mcl.lisp,v 1.7 2008/02/13 16:02:19 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/unix-sbcl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-sbcl.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/unix-sbcl.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/unix-sbcl.lisp,v 1.8 2008/02/13 16:02:19 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-05 12:00:31 UTC (rev 4186) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-09 07:50:25 UTC (rev 4187) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/hunchentoot/util.lisp,v 1.35 2008/04/08 14:39:18 edi Exp $ -;;; Copyright (c) 2004-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions From bknr at bknr.net Mon Feb 9 07:52:10 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 08:52:10 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/ Message-ID: Revision: 4188 Author: edi URL: http://bknr.net/trac/changeset/4188 Happy New Year U trunk/thirdparty/chunga/chunga.asd U trunk/thirdparty/chunga/input.lisp U trunk/thirdparty/chunga/known-words.lisp U trunk/thirdparty/chunga/output.lisp U trunk/thirdparty/chunga/packages.lisp U trunk/thirdparty/chunga/read.lisp U trunk/thirdparty/chunga/specials.lisp U trunk/thirdparty/chunga/streams.lisp U trunk/thirdparty/chunga/util.lisp Modified: trunk/thirdparty/chunga/chunga.asd =================================================================== --- trunk/thirdparty/chunga/chunga.asd 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/chunga.asd 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/chunga.asd,v 1.20 2008/05/24 18:38:30 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/input.lisp =================================================================== --- trunk/thirdparty/chunga/input.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/input.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/input.lisp,v 1.18 2008/05/24 03:06:22 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/known-words.lisp =================================================================== --- trunk/thirdparty/chunga/known-words.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/known-words.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/known-words.lisp,v 1.3 2008/05/29 22:21:09 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/output.lisp =================================================================== --- trunk/thirdparty/chunga/output.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/output.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/output.lisp,v 1.14 2008/05/24 03:06:22 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/packages.lisp,v 1.19 2008/05/24 18:38:30 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/read.lisp =================================================================== --- trunk/thirdparty/chunga/read.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/read.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/read.lisp,v 1.22 2008/05/26 08:18:00 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/specials.lisp =================================================================== --- trunk/thirdparty/chunga/specials.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/specials.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/specials.lisp,v 1.12 2008/05/24 03:06:22 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/streams.lisp =================================================================== --- trunk/thirdparty/chunga/streams.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/streams.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/streams.lisp,v 1.10 2008/05/24 03:06:22 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions Modified: trunk/thirdparty/chunga/util.lisp =================================================================== --- trunk/thirdparty/chunga/util.lisp 2009-02-09 07:50:25 UTC (rev 4187) +++ trunk/thirdparty/chunga/util.lisp 2009-02-09 07:52:10 UTC (rev 4188) @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CHUNGA; Base: 10 -*- ;;; $Header: /usr/local/cvsrep/chunga/util.lisp,v 1.12 2008/05/25 10:53:48 edi Exp $ -;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions From bknr at bknr.net Mon Feb 9 09:03:41 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 10:03:41 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4190 Author: edi URL: http://bknr.net/trac/changeset/4190 Start with conditions A trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/drakma.asd U trunk/thirdparty/drakma/packages.lisp Added: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp (rev 0) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -0,0 +1,88 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: ODD-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/odd-streams/conditions.lisp,v 1.5 2007/12/31 01:08:45 edi Exp $ + +;;; Copyright (c) 2008-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :drakma) + +(define-condition drakma-condition (condition) + () + (:documentation "Superclass for all conditions related to Drakma.")) + +(define-condition drakma-error (drakma-condition error) + () + (:documentation "Superclass for all errors related to Drakma.")) + +(define-condition drakma-simple-error (drakma-error simple-condition) + () + (:documentation "Like DRAKMA-ERROR but with formatting capabilities.")) + +(defun drakma-error (format-control &rest format-arguments) + "Signals an error of type DRAKMA-SIMPLE-ERROR with the provided +format control and arguments." + (error 'drakma-simple-error + :format-control format-control + :format-arguments format-arguments)) + +(define-condition parameter-error (drakma-simple-error) + () + (:documentation "Signalled if a function was called with incosistent or illegal parameters.")) + +(defun parameter-error (format-control &rest format-arguments) + "Signals an error of type PARAMETER-ERROR with the provided +format control and arguments." + (error 'parameter-error + :format-control format-control + :format-arguments format-arguments)) + +(define-condition cookie-error (drakma-simple-error) + ((cookie :initarg :cookie + :initform nil + :reader cookie-error-cookie + :documentation "The COOKIE object that provoked this error. +Can be NIL in case such an object couldn't be initialited.")) + (:documentation "Signalled if someone tries to create a COOKIE object that's not valid.")) + +(defun cookie-error (cookie format-control &rest format-arguments) + "Signals an error of type COOKIE-ERROR with the provided cookie +\(can be NIL), format control and arguments." + (error 'cookie-error + :cookie cookie + :format-control format-control + :format-arguments format-arguments)) + +(define-condition cookie-date-parse-error (cookie-error) + () + (:documentation "Signalled if Drakma tries to parse the date of an +incoming cookie header and can't interpret it.")) + +(defun cookie-date-parse-error (format-control &rest format-arguments) + "Signals an error of type COOKIE-DATE-PARSE-ERROR with the provided +format control and arguments." + (error 'cookie-date-parse-error + :format-control format-control + :format-arguments format-arguments)) Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -31,7 +31,7 @@ (defclass cookie () ((name :initarg :name - :initform (error "A cookie must have a name.") + :initform (cookie-error nil "A cookie must have a name.") :accessor cookie-name :documentation "The name of the cookie.") (value :initarg :value @@ -39,7 +39,7 @@ :accessor cookie-value :documentation "The cookie's value.") (domain :initarg :domain - :initform (error "A cookie must have a domain.") + :initform (cookie-error nil "A cookie must have a domain.") :accessor cookie-domain :documentation "The domain the cookie is valid for.") (path :initarg :path @@ -122,22 +122,22 @@ (eq (uri-scheme uri) :https)))) (defun check-cookie (cookie) - "Checks if the slots of the COOKIE object COOKIE have valid -values and raises a corresponding error otherwise." + "Checks if the slots of the COOKIE object COOKIE have valid values +and raises a corresponding error of type COOKIE-ERROR otherwise." (with-slots (name value domain path expires) cookie (unless (and (stringp name) (plusp (length name))) - (error "Cookie name ~S must be a non-empty string." name)) + (cookie-error cookie "Cookie name ~S must be a non-empty string." name)) (unless (stringp value) - (error "Cookie value ~S must be a non-empty string." value)) + (cookie-error cookie "Cookie value ~S must be a non-empty string." value)) (unless (valid-cookie-domain-p domain) - (error "Invalid cookie domain ~S." domain)) + (cookie-error cookie "Invalid cookie domain ~S." domain)) (unless (and (stringp path) (plusp (length path))) - (error "Cookie path ~S must be a non-empty string." path)) + (cookie-error cookie "Cookie path ~S must be a non-empty string." path)) (unless (or (null expires) (and (integerp expires) (plusp expires))) - (error "Cookie expiry ~S should have been NIL or a universal time." expires)))) + (cookie-error cookie "Cookie expiry ~S should have been NIL or a universal time." expires)))) (defmethod initialize-instance :after ((cookie cookie) &rest initargs) "Check cookie validity after creation." @@ -208,8 +208,9 @@ ;; could try to employ CL-PPCRE, but that'd add a new dependency ;; without making this code much cleaner (handler-case - (let* ((last-space-pos (or (position #\Space string :test #'char= :from-end t) - (error "Can't parse cookie date ~S, no space found." string))) + (let* ((last-space-pos + (or (position #\Space string :test #'char= :from-end t) + (cookie-date-parse-error "Can't parse cookie date ~S, no space found." string))) (time-zone-string (subseq string (1+ last-space-pos))) (time-zone (interpret-as-time-zone time-zone-string)) second minute hour day month year) @@ -217,25 +218,27 @@ (when (and day month) (cond ((every #'digit-char-p part) (when year - (error "Can't parse cookie date ~S, confused by ~S part." string part)) + (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." + string part)) (setq year (parse-integer part))) ((= (count #\: part :test #'char=) 2) (let ((h-m-s (mapcar #'safe-parse-integer (split-string part ":")))) (setq hour (first h-m-s) minute (second h-m-s) second (third h-m-s)))) - (t (error "Can't parse cookie date ~S, confused by ~S part." string part)))) + (t (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." + string part)))) (cond ((null day) (unless (setq day (safe-parse-integer part)) (setq month (interpret-as-month part)))) ((null month) (setq month (interpret-as-month part))))) (unless (and second minute hour day month year) - (error "Can't parse cookie date ~S, component missing." string)) + (cookie-date-parse-error "Can't parse cookie date ~S, component missing." string)) (when (< year 100) (setq year (+ year 2000))) (encode-universal-time second minute hour day month year time-zone)) - (error (condition) + (cookie-date-parse-error (condition) (cond (*ignore-unparseable-cookie-dates-p* (warn "~A" condition) nil) Modified: trunk/thirdparty/drakma/drakma.asd =================================================================== --- trunk/thirdparty/drakma/drakma.asd 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/drakma.asd 2009-02-09 09:03:41 UTC (rev 4190) @@ -49,6 +49,7 @@ :version #.*drakma-version-string* :components ((:file "packages") (:file "specials") + (:file "conditions") (:file "util") (:file "read") (:file "cookies") Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -40,6 +40,8 @@ :*ignore-unparseable-cookie-dates-p* :*text-content-types* :cookie + :cookie-error + :cookie-error-cookie :cookie-domain :cookie-expires :cookie-http-only-p @@ -51,9 +53,12 @@ :cookie-value :cookie= :delete-old-cookies + :drakma-condition + :drakma-error :get-content-type :header-value :http-request + :parameter-error :parameter-present-p :parameter-value :read-tokens-and-parameters From bknr at bknr.net Mon Feb 9 09:15:30 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 10:15:30 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4191 Author: edi URL: http://bknr.net/trac/changeset/4191 More conditions U trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:03:41 UTC (rev 4190) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:15:30 UTC (rev 4191) @@ -59,12 +59,24 @@ :format-control format-control :format-arguments format-arguments)) +(define-condition syntax-error (drakma-simple-error) + () + (:documentation "Signalled if Drakma encounters wrong or unknown +syntax when reading the reply from the server.")) + +(defun syntax-error (format-control &rest format-arguments) + "Signals an error of type SYNTAX-ERROR with the provided +format control and arguments." + (error 'syntax-error + :format-control format-control + :format-arguments format-arguments)) + (define-condition cookie-error (drakma-simple-error) ((cookie :initarg :cookie :initform nil :reader cookie-error-cookie :documentation "The COOKIE object that provoked this error. -Can be NIL in case such an object couldn't be initialited.")) +Can be NIL in case such an object couldn't be initialized.")) (:documentation "Signalled if someone tries to create a COOKIE object that's not valid.")) (defun cookie-error (cookie format-control &rest format-arguments) Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-09 09:03:41 UTC (rev 4190) +++ trunk/thirdparty/drakma/read.lisp 2009-02-09 09:15:30 UTC (rev 4191) @@ -35,19 +35,20 @@ three values - the protocol \(HTTP version) as a keyword, the status code as an integer, and optionally the reason phrase." (let* ((*current-error-message* "While reading status line:") - (line (read-line* stream log-stream)) + (line (or (read-line* stream log-stream) + (error "Could not read status line."))) (first-space-pos (or (position #\Space line :test #'char=) - (error "No space in status line ~S." line))) + (syntax-error "No space in status line ~S." line))) (second-space-pos (position #\Space line :test #'char= :start (1+ first-space-pos)))) (list (cond ((string-equal line "HTTP/1.0" :end1 first-space-pos) :http/1.0) ((string-equal line "HTTP/1.1" :end1 first-space-pos) :http/1.1) - (t (error "Unknown protocol in ~S." line))) + (t (syntax-error "Unknown protocol in ~S." line))) (or (ignore-errors (parse-integer line :start (1+ first-space-pos) :end second-space-pos)) - (error "Status code in ~S is not an integer." line)) + (syntax-error "Status code in ~S is not an integer." line)) (and second-space-pos (subseq line (1+ second-space-pos)))))) (defun get-content-type (headers) Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 09:03:41 UTC (rev 4190) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 09:15:30 UTC (rev 4191) @@ -84,7 +84,7 @@ (and (symbolp content) (fboundp content))) (funcall content stream)) - (t (error "Don't know how to send content ~S to server." content))))) + (t (parameter-error "Don't know how to send content ~S to server." content))))) (defun make-form-data-function (parameters boundary) "Creates and returns a closure which can be used as an argument for @@ -124,8 +124,9 @@ (crlf) (crlf) ;; use SEND-CONTENT to send file as binary data (send-content file-source stream))) - (t (error "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body." - name value))) + (t (parameter-error + "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body." + name value))) (crlf))) (format stream "--~A--" boundary) (crlf)))) @@ -147,7 +148,7 @@ (content-length (when chunkedp ;; see RFC 2616, section 4.4 - (error "Got Content-Length header although input chunking is on.")) + (syntax-error "Got Content-Length header although input chunking is on.")) (setf (flexi-stream-element-type stream) 'octet) (let ((result (make-array content-length :element-type 'octet))) #+:clisp @@ -388,19 +389,19 @@ that time, a COMMUNICATION-DEADLINE-EXPIRED condition is signalled. DEADLINE is available on CCL 1.2 and later." (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq) - (error "Don't know how to handle protocol ~S." protocol)) + (parameter-error "Don't know how to handle protocol ~S." protocol)) (setq uri (cond ((uri-p uri) (copy-uri uri)) (t (parse-uri uri)))) (unless (member method +known-methods+ :test #'eq) - (error "Don't know how to handle method ~S." method)) + (parameter-error "Don't know how to handle method ~S." method)) (unless (member (uri-scheme uri) '(:http :https) :test #'eq) - (error "Don't know how to handle scheme ~S." (uri-scheme uri))) + (parameter-error "Don't know how to handle scheme ~S." (uri-scheme uri))) (when (and close keep-alive) - (error "CLOSE and KEEP-ALIVE must not be both true.")) + (parameter-error "CLOSE and KEEP-ALIVE must not be both true.")) (when (and (eq content :continuation) content-length) - (error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION.")) + (parameter-error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION.")) (when (and form-data (not (eq method :post))) - (error "FORM-DATA makes only sense with POST requests.")) + (parameter-error "FORM-DATA makes only sense with POST requests.")) ;; convert PROXY argument to canonical form (when proxy (when (atom proxy) @@ -410,8 +411,8 @@ (file-parameters-p (find-if-not #'stringp parameters :key #'cdr)) parameters-used-p) (when (and file-parameters-p (not (eq method :post))) - (error "Don't know how to handle parameters in ~S, as this is not a POST request." - parameters)) + (parameter-error "Don't know how to handle parameters in ~S, as this is not a POST request." + parameters)) (when (eq method :post) ;; create content body for POST unless it was provided (unless content From bknr at bknr.net Mon Feb 9 09:29:04 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 10:29:04 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4192 Author: edi URL: http://bknr.net/trac/changeset/4192 Even more conditions U trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/packages.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/request.lisp U trunk/thirdparty/drakma/util.lisp Modified: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -41,13 +41,21 @@ () (:documentation "Like DRAKMA-ERROR but with formatting capabilities.")) -(defun drakma-error (format-control &rest format-arguments) - "Signals an error of type DRAKMA-SIMPLE-ERROR with the provided -format control and arguments." - (error 'drakma-simple-error - :format-control format-control - :format-arguments format-arguments)) +(define-condition drakma-warning (drakma-condition warning) + () + (:documentation "Superclass for all warnings related to Drakma.")) +(define-condition drakma-simple-warning (drakma-warning simple-condition) + () + (:documentation "Like DRAKMA-WARNING but with formatting capabilities.")) + +(defun drakma-warn (format-control &rest format-arguments) + "Signals a warning of type DRAKMA-SIMPLE-WARNING with the +provided format control and arguments." + (warn 'drakma-simple-warning + :format-control format-control + :format-arguments format-arguments)) + (define-condition parameter-error (drakma-simple-error) () (:documentation "Signalled if a function was called with incosistent or illegal parameters.")) Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -240,7 +240,7 @@ (encode-universal-time second minute hour day month year time-zone)) (cookie-date-parse-error (condition) (cond (*ignore-unparseable-cookie-dates-p* - (warn "~A" condition) + (drakma-warn "~A" condition) nil) (t (error condition)))))) Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -55,6 +55,7 @@ :delete-old-cookies :drakma-condition :drakma-error + :drakma-warning :get-content-type :header-value :http-request Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/read.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -36,7 +36,8 @@ status code as an integer, and optionally the reason phrase." (let* ((*current-error-message* "While reading status line:") (line (or (read-line* stream log-stream) - (error "Could not read status line."))) + (error 'drakma-simple-error + :format-control "No status line - probably network error."))) (first-space-pos (or (position #\Space line :test #'char=) (syntax-error "No space in status line ~S." line))) (second-space-pos (position #\Space line Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -54,8 +54,8 @@ (t external-format-in)))) (make-external-format name :eol-style :lf))))) (error (condition) - (warn "Problems determining charset \(falling back to binary):~%~A" - condition)))) + (drakma-warn "Problems determining charset \(falling back to binary):~%~A" + condition)))) (defun send-content (content stream &optional external-format-out) "Sends CONTENT to the stream STREAM as part of the request body @@ -442,7 +442,7 @@ (not :lw-does-not-have-write-timeout)) (when use-ssl (when (and write-timeout write-timeout-provided-p) - (warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) + (drakma-warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) (setq write-timeout nil)) (setq http-stream (or stream #+:lispworks @@ -613,18 +613,21 @@ (and (integerp redirect) (plusp redirect))) (cerror "Continue anyway." - "Status code was ~A, but ~ + 'drakma-simple-error + :format-control "Status code was ~A, but ~ ~:[REDIRECT is ~S~;redirection limit has been exceeded~]." - status-code (integerp redirect) redirect)) + :format-arguments (list status-code (integerp redirect) redirect))) (when auto-referer (setq additional-headers (set-referer uri additional-headers))) (let* ((location (header-value :location headers)) - (new-uri (merge-uris (cond ((or (null location) - (zerop (length location))) - (warn "Empty `Location' header, assuming \"/\".") - "/") - (t location)) - uri)) + (new-uri (merge-uris + (cond ((or (null location) + (zerop (length location))) + (drakma-warn + "Empty `Location' header, assuming \"/\".") + "/") + (t location)) + uri)) ;; can we re-use the stream? (old-server-p (and (string= (uri-host new-uri) (uri-host uri)) @@ -671,7 +674,7 @@ (multiple-value-setq (body trailers) (read-body http-stream headers must-close external-format-body)) (when trailers - (warn "Adding trailers from chunked encoding to HTTP headers.") + (drakma-warn "Adding trailers from chunked encoding to HTTP headers.") (setq headers (nconc headers trailers))))) (setq done t) (values (cond (want-stream http-stream) Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/util.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -250,7 +250,7 @@ (every (lambda (pos) (digit-char-p (char string pos))) '(4 5 7 8))) - (error "Can't interpret ~S as a time zone." string)) + (cookie-date-parse-error "Can't interpret ~S as a time zone." string)) (let ((hours (parse-integer string :start 4 :end 6)) (minutes (parse-integer string :start 7 :end 9))) (* (if (char= (char string 3) #\+) -1 1) From bknr at bknr.net Mon Feb 9 09:34:30 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 10:34:30 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/doc/index.html Message-ID: Revision: 4193 Author: edi URL: http://bknr.net/trac/changeset/4193 Clarify compatibility U trunk/thirdparty/chunga/doc/index.html Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-09 09:29:04 UTC (rev 4192) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-09 09:34:30 UTC (rev 4193) @@ -101,7 +101,11 @@ Chunga together with this documentation can be downloaded from http://weitz.de/files/chunga.tar.gz. The -current version is 0.4.3. Chunga will only work with Lisps where +current version is 0.5.0. (This version is not compatible with +pre-2009 releases +of Hunchentoot +or Drakma.) Chunga will only +work with Lisps where the character codes of all Latin-1 From bknr at bknr.net Mon Feb 9 09:57:29 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 10:57:29 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4194 Author: edi URL: http://bknr.net/trac/changeset/4194 Update documentation U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/doc/index.html U trunk/thirdparty/drakma/packages.lisp Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 09:34:30 UTC (rev 4193) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 09:57:29 UTC (rev 4194) @@ -1,3 +1,7 @@ +Version 0.12.0 +2009-02-09 +Use the new ("binary") version of Chunga +Added conditions types Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) Fix generation of user agent header (bug caught by Chaitanya Gupta) Modified: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:34:30 UTC (rev 4193) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:57:29 UTC (rev 4194) @@ -58,7 +58,7 @@ (define-condition parameter-error (drakma-simple-error) () - (:documentation "Signalled if a function was called with incosistent or illegal parameters.")) + (:documentation "Signalled if a function was called with inconsistent or illegal parameters.")) (defun parameter-error (format-control &rest format-arguments) "Signals an error of type PARAMETER-ERROR with the provided Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-09 09:34:30 UTC (rev 4193) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-09 09:57:29 UTC (rev 4194) @@ -96,6 +96,17 @@
  • parameter-value
  • get-content-type +
  • Conditions +
      +
    1. drakma-condition +
    2. drakma-error +
    3. drakma-warning +
    4. syntax-error +
    5. parameter-error +
    6. cookie-error +
    7. cookie-error-cookie +
    8. cookie-date-parse-error +
  • Potential problems
  • Acknowledgements @@ -643,7 +654,7 @@ Drakma together with this documentation can be downloaded from http://weitz.de/files/drakma.tar.gz. -The current version is 0.11.5. Drakma can be installed +The current version is 0.12.0. Drakma can be installed via ASDF and depends on the open source libraries CL-BASE64 (use @@ -1284,6 +1295,8 @@ Whether Drakma is allowed to treat Expires dates in cookie headers as non-existent if it can't parse them. If the value of this variable is NIL (which is the default), an error +of +type COOKIE-DATE-PARSE-ERROR will be signalled instead.

    Note that Drakma tries hard to parse every date representation its @@ -1451,6 +1464,109 @@ +

    Conditions

    + +This section lists all the condition types that are defined by Drakma. + + + +


    [Condition] +
    drakma-condition + +


    +All conditions signalled by Drakma are of this type. This is a subtype of CONDITION. +
    + + + + + +


    [Error] +
    drakma-error + +


    +All errors signalled by Drakma are of this type. This is a subtype of DRAKMA-CONDITION and of ERROR. +
    + + + + + +


    [Warning] +
    drakma-warning + +


    +All warnings signalled by Drakma are of this type. This is a subtype of DRAKMA-CONDITION and of WARNING. +
    + + + + + +


    [Error] +
    syntax-error + +


    An error of this type is signalled if Drakma +encounters wrong or unknown syntax when reading the reply from the +server. This is a subtype +of DRAKMA-ERROR. +
    + + + + + +


    [Error] +
    parameter-error + +


    An error of this type is signalled if a function was +called with inconsistent or illegal parameters. This is a subtype +of DRAKMA-ERROR. +
    + + + + + +


    [Error] +
    cookie-error + +


    An error of this type is signalled in case of an +attempt to create a COOKIE object +that's not valid. This is a subtype +of DRAKMA-ERROR. The +condition object contains a cookie slot which can be accessed with the +COOKIE-ERROR-COOKIE reader. Note that the content of this slot can be +NIL if the cookie couldn't be initialized. +
    + + + +


    [Reader] +
    cookie-error-cookie error => cookie-or-nil + +


    If error is of +type COOKIE-ERROR, this +function will return the associated invalid cookie or NIL if the +cookie couldn't be created. +
    + + + +


    [Error] +
    cookie-date-parse-error + +


    An error of this type is signalled if Drakma tried to +parse the date of an incoming cookie header and can't interpret it. +This is a subtype +of COOKIE-ERROR. +

    +See also *IGNORE-UNPARSEABLE-COOKIE-DATES-P*. +

    + + + +
     

    Potential problems

    Some web servers (notably Paul Graham's Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:34:30 UTC (rev 4193) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:57:29 UTC (rev 4194) @@ -42,6 +42,7 @@ :cookie :cookie-error :cookie-error-cookie + :cookie-date-parse-error :cookie-domain :cookie-expires :cookie-http-only-p @@ -63,4 +64,5 @@ :parameter-present-p :parameter-value :read-tokens-and-parameters - :split-tokens)) + :split-tokens + :syntax-error)) From bknr at bknr.net Mon Feb 9 10:08:05 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 11:08:05 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/usocket/ Message-ID: Revision: 4195 Author: hans URL: http://bknr.net/trac/changeset/4195 update from usocket trunk _U trunk/thirdparty/usocket/ U trunk/thirdparty/usocket/backend/openmcl.lisp Property changes on: trunk/thirdparty/usocket ___________________________________________________________________ Name: piston:local-revision - 4172 + 4194 Name: piston:remote-revision - 483 + 489 Modified: trunk/thirdparty/usocket/backend/openmcl.lisp =================================================================== --- trunk/thirdparty/usocket/backend/openmcl.lisp 2009-02-09 09:57:29 UTC (rev 4194) +++ trunk/thirdparty/usocket/backend/openmcl.lisp 2009-02-09 10:08:05 UTC (rev 4195) @@ -1,4 +1,4 @@ -;;;; $Id: openmcl.lisp 439 2008-10-21 12:25:53Z ehuelsmann $ +;;;; $Id: openmcl.lisp 489 2009-02-09 10:08:05Z hhubner $ ;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/backend/openmcl.lisp $ ;;;; See LICENSE for licensing information. @@ -123,10 +123,14 @@ (close (socket usocket)))) (defmethod get-local-address ((usocket usocket)) - (hbo-to-vector-quad (openmcl-socket:local-host (socket usocket)))) + (let ((address (openmcl-socket:local-host (socket usocket)))) + (when address + (hbo-to-vector-quad address)))) (defmethod get-peer-address ((usocket stream-usocket)) - (hbo-to-vector-quad (openmcl-socket:remote-host (socket usocket)))) + (let ((address (openmcl-socket:remote-host (socket usocket)))) + (when address + (hbo-to-vector-quad address)))) (defmethod get-local-port ((usocket usocket)) (openmcl-socket:local-port (socket usocket))) From bknr at bknr.net Mon Feb 9 10:14:59 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 11:14:59 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4196 Author: edi URL: http://bknr.net/trac/changeset/4196 Be liberal about content length U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/doc/index.html U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 10:08:05 UTC (rev 4195) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 10:14:59 UTC (rev 4196) @@ -1,6 +1,7 @@ Version 0.12.0 2009-02-09 Use the new ("binary") version of Chunga +Be more lenient about content length (thanks to Zach Beane and "pix") Added conditions types Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) Fix generation of user agent header (bug caught by Chaitanya Gupta) Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-09 10:08:05 UTC (rev 4195) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-09 10:14:59 UTC (rev 4196) @@ -881,13 +881,12 @@ content body. Note that this will not work with some older web servers.

    -A non-NIL content-length argument -means that Drakma must build the request body in RAM and -compute the content length even if it would have otherwise used -chunked encoding - for example in the case of file uploads. A special -case is the value T -for content-length which means that Drakma should -compute the content length after building the request body. +Providing +a true +CONTENT-LENGTH argument which is not a non-negative integer means that +Drakma must build the request body in RAM and compute the +content length even if it would have otherwise used chunked encoding, +for example in the case of file uploads.

    content-type is the corresponding 'Content-Type' header to be sent and will be ignored Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 10:08:05 UTC (rev 4195) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 10:14:59 UTC (rev 4196) @@ -285,12 +285,10 @@ send the content body. Note that this will not work with older web servers. -A non-NIL CONTENT-LENGTH argument means that Drakma /must/ build the -request body in RAM and compute the content length even if it would -have otherwise used chunked encoding, for example in the case of file -uploads. A special case is the value T for CONTENT-LENGTH which means -that Drakma should compute the content length after building the -request body. +Providing a true CONTENT-LENGTH argument which is not a non-negative +integer means that Drakma /must/ build the request body in RAM and +compute the content length even if it would have otherwise used +chunked encoding, for example in the case of file uploads. CONTENT-TYPE is the corresponding `Content-Type' header to be sent and will be ignored unless CONTENT is provided as well. @@ -398,8 +396,6 @@ (parameter-error "Don't know how to handle scheme ~S." (uri-scheme uri))) (when (and close keep-alive) (parameter-error "CLOSE and KEEP-ALIVE must not be both true.")) - (when (and (eq content :continuation) content-length) - (parameter-error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION.")) (when (and form-data (not (eq method :post))) (parameter-error "FORM-DATA makes only sense with POST requests.")) ;; convert PROXY argument to canonical form @@ -550,7 +546,9 @@ (when content-type (write-header "Content-Type" "~A" content-type)) (when (and content-length - (not (or (arrayp content) + (not (or (and (integerp content-length) + (not (minusp content-length))) + (arrayp content) (listp content) (eq content :continuation)))) ;; CONTENT-LENGTH forces us to compute request body From bknr at bknr.net Mon Feb 9 10:46:38 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 11:46:38 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/connection-manager.lisp Message-ID: Revision: 4197 Author: hans URL: http://bknr.net/trac/changeset/4197 improve comment (from ITA r234477) U trunk/thirdparty/hunchentoot/connection-manager.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 10:14:59 UTC (rev 4196) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 10:46:38 UTC (rev 4197) @@ -62,9 +62,9 @@ instance. The SOCKET argument is passed to START-REQUEST-PROCESSING as argument. -In a multi-threaded environment, the connection manager runs the thunk -in a separate thread. In a single-threaded environment, the thunk -will be called directly.")) +In a multi-threaded environment, the connection manager runs this function +in a separate thread. In a single-threaded environment, this function +is called directly.")) (defgeneric shutdown (connection-manager) (:documentation "Terminate all threads that are currently associated From bknr at bknr.net Mon Feb 9 10:47:35 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 11:47:35 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/connection-manager.lisp Message-ID: Revision: 4198 Author: hans URL: http://bknr.net/trac/changeset/4198 guard against closed sockets (from ITA r235337) U trunk/thirdparty/hunchentoot/connection-manager.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 10:46:38 UTC (rev 4197) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 10:47:35 UTC (rev 4198) @@ -127,10 +127,16 @@ nil #'process-connection (server manager) handle)) +(defun client-as-string (socket) + (let ((address (usocket:get-peer-address socket)) + (port (usocket:get-peer-port socket))) + (when (and address port) + (format nil "~A:~A" + (usocket:vector-quad-to-dotted-quad address) + port)))) + #-:lispworks (defmethod handle-incoming-connection ((manager one-thread-per-connection-manager) socket) (bt:make-thread (lambda () (process-connection (server manager) socket)) - :name (format nil "Hunchentoot worker \(client: ~A:~A)" - (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket)) - (usocket:get-peer-port socket)))) + :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) From bknr at bknr.net Mon Feb 9 11:01:48 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 12:01:48 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4199 Author: edi URL: http://bknr.net/trac/changeset/4199 Version bump U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/doc/index.html Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 10:47:35 UTC (rev 4198) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 11:01:48 UTC (rev 4199) @@ -1,8 +1,9 @@ -Version 0.12.0 +Version 1.0.0 2009-02-09 Use the new ("binary") version of Chunga +Added conditions types +Some performance improvements Be more lenient about content length (thanks to Zach Beane and "pix") -Added conditions types Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) Fix generation of user agent header (bug caught by Chaitanya Gupta) Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-09 10:47:35 UTC (rev 4198) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-09 11:01:48 UTC (rev 4199) @@ -654,13 +654,13 @@ Drakma together with this documentation can be downloaded from http://weitz.de/files/drakma.tar.gz. -The current version is 0.12.0. Drakma can be installed +The current version is 1.0.0. Drakma can be installed via ASDF and depends on the open source libraries CL-BASE64 (use 3.3.2 or higher to avoid an unneeded dependency on KMRCL), Puri, FLEXI-STREAMS, -and Chunga (0.5.0 or higher). +and Chunga (1.0.0 or higher). If you're not using LispWorks, you'll also need usocket (0.3.2 or newer) and (except From bknr at bknr.net Mon Feb 9 11:15:17 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 12:15:17 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4200 Author: edi URL: http://bknr.net/trac/changeset/4200 Some more tweaks U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/doc/index.html U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 11:01:48 UTC (rev 4199) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-09 11:15:17 UTC (rev 4200) @@ -6,6 +6,8 @@ Be more lenient about content length (thanks to Zach Beane and "pix") Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) Fix generation of user agent header (bug caught by Chaitanya Gupta) +Added DEADLINE parameter for CCL (thanks to Hans H?bner) +Fixed bug where READ-BODY returned NIL although TEXTP was true (thanks to Hans H?bner) Version 0.11.5 2008-03-21 Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-09 11:01:48 UTC (rev 4199) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-09 11:15:17 UTC (rev 4200) @@ -724,7 +724,7 @@ -


    [Function]
    http-request uri &key protocol method force-ssl parameters form-data content content-length content-type cookie-jar basic-authorization user-agent accept proxy proxy-basic-authorization additional-headers redirect redirect-methods auto-referer keep-alive close external-format-out external-format-in force-binary want-stream stream connection-timeout read-timeout write-timeout
    => body-or-stream, status-code, headers, uri, stream, must-close, reason-phrase
    +


    [Function]
    http-request uri &key protocol method force-ssl parameters form-data content content-length content-type cookie-jar basic-authorization user-agent accept proxy proxy-basic-authorization additional-headers redirect redirect-methods auto-referer keep-alive close external-format-out external-format-in force-binary want-stream stream connection-timeout read-timeout write-timeout deadline
    => body-or-stream, status-code, headers, uri, stream, must-close, reason-phrase


    Sends an HTTP request to a web server and returns its reply. @@ -1030,6 +1030,16 @@ arguments are only available for LispWorks, write-timeout is only available for LispWorks 5.0 or higher. +

    +deadline, a time +in the future, specifies the time until which the request should be +finished. The deadline is specified +in internal +time units. If the server fails to respond until that time, a +COMMUNICATION-DEADLINE-EXPIRED +condition is signalled. DEADLINE is only available +on CCL 1.2 +and later.

    Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 11:01:48 UTC (rev 4199) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 11:15:17 UTC (rev 4200) @@ -381,11 +381,10 @@ LispWorks 5.0 or higher. DEADLINE, a time in the future, specifies the time until which the -request should be finished. The DEADLINE is specified in internal -time units (see (GET-INTERNAL-TIME-UNITS) and -INTERNAL-TIME-UNITS-PER-SECOND). If the server fails to respond until -that time, a COMMUNICATION-DEADLINE-EXPIRED condition is signalled. -DEADLINE is available on CCL 1.2 and later." +request should be finished. The deadline is specified in internal +time units. If the server fails to respond until that time, a +COMMUNICATION-DEADLINE-EXPIRED condition is signalled. DEADLINE is +only available on CCL 1.2 and later." (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq) (parameter-error "Don't know how to handle protocol ~S." protocol)) (setq uri (cond ((uri-p uri) (copy-uri uri)) @@ -459,9 +458,11 @@ :nodelay t)))) #+openmcl (when deadline - ;; It is correct to set the deadline here even though it may have been initialized - ;; by SOCKET-CONNECT already: The stream may have been passed in by the user and - ;; the user may want to adjust the deadline for every request. + ;; it is correct to set the deadline here even though + ;; it may have been initialized by SOCKET-CONNECT + ;; already - the stream may have been passed in by the + ;; user and the user may want to adjust the deadline + ;; for every request. (setf (ccl:stream-deadline http-stream) deadline)) (when (and use-ssl ;; don't attach SSL to existing streams From bknr at bknr.net Mon Feb 9 11:30:37 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 12:30:37 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/ Message-ID: Revision: 4201 Author: edi URL: http://bknr.net/trac/changeset/4201 Small doc tweaks U trunk/thirdparty/chunga/CHANGELOG.txt U trunk/thirdparty/chunga/doc/index.html Modified: trunk/thirdparty/chunga/CHANGELOG.txt =================================================================== --- trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-09 11:15:17 UTC (rev 4200) +++ trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-09 11:30:37 UTC (rev 4201) @@ -1,3 +1,9 @@ +Version 1.0.0 +2009-02-10 +Switched to binary streams underneath and got rid of FLEXI-STREAMS dependency +Exported (an improved version of) AS-KEYWORD +Added WITH-CHARACTER-STREAM-SEMANTICS + Version 0.4.3 2008-05-23 Cleanup, reduce some consing Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-09 11:15:17 UTC (rev 4200) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-09 11:30:37 UTC (rev 4201) @@ -101,7 +101,7 @@ Chunga together with this documentation can be downloaded from http://weitz.de/files/chunga.tar.gz. The -current version is 0.5.0. (This version is not compatible with +current version is 1.0.0. (This version is not compatible with pre-2009 releases of Hunchentoot or Drakma.) Chunga will only From bknr at bknr.net Mon Feb 9 11:47:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 12:47:33 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/connection-manager.lisp Message-ID: Revision: 4202 Author: edi URL: http://bknr.net/trac/changeset/4202 Not for LispWorks U trunk/thirdparty/hunchentoot/connection-manager.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 11:30:37 UTC (rev 4201) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 11:47:33 UTC (rev 4202) @@ -127,6 +127,7 @@ nil #'process-connection (server manager) handle)) +#-:lispworks (defun client-as-string (socket) (let ((address (usocket:get-peer-address socket)) (port (usocket:get-peer-port socket))) From bknr at bknr.net Mon Feb 9 11:52:41 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 12:52:41 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4203 Author: edi URL: http://bknr.net/trac/changeset/4203 Some LW fixes U trunk/thirdparty/hunchentoot/connection-manager.lisp U trunk/thirdparty/hunchentoot/server.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 11:47:33 UTC (rev 4202) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 11:52:41 UTC (rev 4203) @@ -71,10 +71,10 @@ with the connection manager, if any.") (:method (manager) #+:lispworks - (when-let (listener (server-listener (server manager))) - ;; kill the main listener process, see LW documentation for + (when-let (acceptor (server-acceptor (server manager))) + ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER - (mp:process-kill listener)))) + (mp:process-kill acceptor)))) (defclass single-threaded-connection-manager (connection-manager) () Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-09 11:47:33 UTC (rev 4202) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-09 11:52:41 UTC (rev 4203) @@ -83,7 +83,7 @@ #+:lispworks (acceptor :accessor server-acceptor :documentation "The Lisp process which accepts incoming - requests.") +requests.") #-:lispworks (listen-socket :accessor server-listen-socket :documentation "The listen socket for incoming @@ -376,7 +376,7 @@ :wait t) (when startup-condition (error startup-condition)) - (process-stop listener-process) + (mp:process-stop listener-process) (setf (server-acceptor server) listener-process)) #-:lispworks (setf (server-listen-socket server) @@ -392,7 +392,7 @@ using HANDLE-INCOMING-CONNECTION.") (:method ((server server)) #+:lispworks - (process-unstop (server-acceptor server)) + (mp:process-unstop (server-acceptor server)) #-:lispworks (usocket:with-server-socket (listener (server-listen-socket server)) (do ((new-connection-p (usocket:wait-for-input listener :timeout +new-connection-wait-time+) @@ -407,9 +407,8 @@ (server-write-timeout server)) (handle-incoming-connection (server-connection-manager server) client-connection))) - (usocket:connection-aborted-error () - ;; ignore condition - ))))))) + ;; ignore condition + (usocket:connection-aborted-error ()))))))) (defgeneric initialize-connection-stream (server stream) (:documentation "Wraps the given STREAM with all the additional From bknr at bknr.net Mon Feb 9 12:13:27 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 13:13:27 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/server.lisp Message-ID: Revision: 4204 Author: hans URL: http://bknr.net/trac/changeset/4204 When you don't understand DO, use LOOP U trunk/thirdparty/hunchentoot/server.lisp Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-09 11:52:41 UTC (rev 4203) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-09 12:13:27 UTC (rev 4204) @@ -395,20 +395,18 @@ (mp:process-unstop (server-acceptor server)) #-:lispworks (usocket:with-server-socket (listener (server-listen-socket server)) - (do ((new-connection-p (usocket:wait-for-input listener :timeout +new-connection-wait-time+) - (usocket:wait-for-input listener :timeout +new-connection-wait-time+))) - ((server-shutdown-p server)) - (when new-connection-p - (handler-case - (let ((client-connection (usocket:socket-accept listener))) - (when client-connection + (loop + until (server-shutdown-p server) + when (usocket:wait-for-input listener :timeout +new-connection-wait-time+) + do (handler-case + (when-let (client-connection (usocket:socket-accept listener)) (set-timeouts client-connection (server-read-timeout server) (server-write-timeout server)) (handle-incoming-connection (server-connection-manager server) - client-connection))) - ;; ignore condition - (usocket:connection-aborted-error ()))))))) + client-connection)) + ;; ignore condition + (usocket:connection-aborted-error ())))))) (defgeneric initialize-connection-stream (server stream) (:documentation "Wraps the given STREAM with all the additional From bknr at bknr.net Mon Feb 9 12:14:17 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 13:14:17 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/connection-manager.lisp Message-ID: Revision: 4205 Author: hans URL: http://bknr.net/trac/changeset/4205 Specialize method on T to silence "unused variable" warning in CCL. U trunk/thirdparty/hunchentoot/connection-manager.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 12:13:27 UTC (rev 4204) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-09 12:14:17 UTC (rev 4205) @@ -69,7 +69,7 @@ (defgeneric shutdown (connection-manager) (:documentation "Terminate all threads that are currently associated with the connection manager, if any.") - (:method (manager) + (:method ((manager t)) #+:lispworks (when-let (acceptor (server-acceptor (server manager))) ;; kill the main acceptor process, see LW documentation for From bknr at bknr.net Mon Feb 9 12:15:01 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 13:15:01 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/chunga/ Message-ID: Revision: 4206 Author: hans URL: http://bknr.net/trac/changeset/4206 Specialize some arguments on type T to silence CCL warnings. U trunk/thirdparty/chunga/input.lisp U trunk/thirdparty/chunga/output.lisp Modified: trunk/thirdparty/chunga/input.lisp =================================================================== --- trunk/thirdparty/chunga/input.lisp 2009-02-09 12:14:17 UTC (rev 4205) +++ trunk/thirdparty/chunga/input.lisp 2009-02-09 12:15:01 UTC (rev 4206) @@ -29,15 +29,15 @@ (in-package :chunga) -(defmethod chunked-input-stream-extensions (object) +(defmethod chunked-input-stream-extensions ((object t)) "The default method which always returns the empty list." nil) -(defmethod chunked-input-stream-trailers (object) +(defmethod chunked-input-stream-trailers ((object t)) "The default method which always returns the empty list." nil) -(defmethod chunked-stream-input-chunking-p (object) +(defmethod chunked-stream-input-chunking-p ((object t)) "The default method for all objects which are not of type CHUNKED-INPUT-STREAM." nil) Modified: trunk/thirdparty/chunga/output.lisp =================================================================== --- trunk/thirdparty/chunga/output.lisp 2009-02-09 12:14:17 UTC (rev 4205) +++ trunk/thirdparty/chunga/output.lisp 2009-02-09 12:15:01 UTC (rev 4206) @@ -29,7 +29,7 @@ (in-package :chunga) -(defmethod chunked-stream-output-chunking-p (object) +(defmethod chunked-stream-output-chunking-p ((object t)) "The default method for all objects which are not of type CHUNKED-OUTPUT-STREAM." nil) From bknr at bknr.net Mon Feb 9 12:15:29 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 13:15:29 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/cl-ppcre/convert.lisp Message-ID: Revision: 4207 Author: hans URL: http://bknr.net/trac/changeset/4207 Specialize some arguments on type T to silence CCL warnings. U trunk/thirdparty/cl-ppcre/convert.lisp Modified: trunk/thirdparty/cl-ppcre/convert.lisp =================================================================== --- trunk/thirdparty/cl-ppcre/convert.lisp 2009-02-09 12:15:01 UTC (rev 4206) +++ trunk/thirdparty/cl-ppcre/convert.lisp 2009-02-09 12:15:29 UTC (rev 4207) @@ -325,7 +325,7 @@ (:documentation "Helper function for CONVERT-AUX which converts parse trees which are conses and dispatches on TOKEN which is the first element of the parse tree.") - (:method (token parse-tree &key) + (:method (token (parse-tree t) &key) (signal-syntax-error "Unknown token ~A in parse-tree." token))) (defmethod convert-compound-parse-tree ((token (eql :sequence)) parse-tree &key) From bknr at bknr.net Mon Feb 9 12:15:51 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 13:15:51 +0100 Subject: [bknr-cvs] hans changed ediware/ Message-ID: Revision: 4208 Author: hans URL: http://bknr.net/trac/changeset/4208 add more dependencies _U ediware/ Property changes on: ediware ___________________________________________________________________ Name: svn:externals - bordeaux-threads svn://bknr.net/svn/trunk/thirdparty/bordeaux-threads_0.4.0 cffi svn://bknr.net/svn/trunk/thirdparty/cffi chunga svn://bknr.net/svn/trunk/thirdparty/chunga cl+ssl svn://bknr.net/svn/trunk/thirdparty/cl+ssl cl-base64 svn://bknr.net/svn/trunk/thirdparty/cl-base64-3.3.2 cl-fad svn://bknr.net/svn/trunk/thirdparty/cl-fad-0.6.2 cl-ppcre svn://bknr.net/svn/trunk/thirdparty/cl-ppcre cl-interpol svn://bknr.net/svn/trunk/thirdparty/cl-interpol cl-unicode svn://bknr.net/svn/trunk/thirdparty/cl-unicode cl-webdav svn://bknr.net/svn/trunk/thirdparty/cl-webdav cl-who svn://bknr.net/svn/trunk/thirdparty/cl-who-0.11.0 drakma svn://bknr.net/svn/trunk/thirdparty/drakma flexi-streams svn://bknr.net/svn/trunk/thirdparty/flexi-streams hunchentoot svn://bknr.net/svn/trunk/thirdparty/hunchentoot md5 svn://bknr.net/svn/trunk/thirdparty/md5-1.8.5 puri svn://bknr.net/svn/trunk/thirdparty/puri-1.5.1 rfc2388 svn://bknr.net/svn/trunk/thirdparty/rfc2388 split-sequence svn://bknr.net/svn/trunk/thirdparty/split-sequence trivial-gray-streams svn://bknr.net/svn/trunk/thirdparty/trivial-gray-streams url-rewrite svn://bknr.net/svn/trunk/thirdparty/url-rewrite-0.1.1 usocket svn://bknr.net/svn/trunk/thirdparty/usocket + bordeaux-threads svn://bknr.net/svn/trunk/thirdparty/bordeaux-threads_0.4.0 cffi svn://bknr.net/svn/trunk/thirdparty/cffi alexandria svn://bknr.net/svn/trunk/thirdparty/alexandria babel svn://bknr.net/svn/trunk/thirdparty/babel chunga svn://bknr.net/svn/trunk/thirdparty/chunga trivial-features svn://bknr.net/svn/trunk/thirdparty/trivial-features cl+ssl svn://bknr.net/svn/trunk/thirdparty/cl+ssl cl-base64 svn://bknr.net/svn/trunk/thirdparty/cl-base64-3.3.2 cl-fad svn://bknr.net/svn/trunk/thirdparty/cl-fad-0.6.2 cl-ppcre svn://bknr.net/svn/trunk/thirdparty/cl-ppcre cl-interpol svn://bknr.net/svn/trunk/thirdparty/cl-interpol cl-unicode svn://bknr.net/svn/trunk/thirdparty/cl-unicode cl-webdav svn://bknr.net/svn/trunk/thirdparty/cl-webdav cl-who svn://bknr.net/svn/trunk/thirdparty/cl-who-0.11.0 drakma svn://bknr.net/svn/trunk/thirdparty/drakma flexi-streams svn://bknr.net/svn/trunk/thirdparty/flexi-streams hunchentoot svn://bknr.net/svn/trunk/thirdparty/hunchentoot md5 svn://bknr.net/svn/trunk/thirdparty/md5-1.8.5 puri svn://bknr.net/svn/trunk/thirdparty/puri-1.5.1 rfc2388 svn://bknr.net/svn/trunk/thirdparty/rfc2388 split-sequence svn://bknr.net/svn/trunk/thirdparty/split-sequence trivial-gray-streams svn://bknr.net/svn/trunk/thirdparty/trivial-gray-streams url-rewrite svn://bknr.net/svn/trunk/thirdparty/url-rewrite-0.1.1 usocket -r489 svn://common-lisp.net/project/usocket/svn/usocket/trunk From bknr at bknr.net Mon Feb 9 13:43:39 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 14:43:39 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/drakma.asd Message-ID: Revision: 4209 Author: edi URL: http://bknr.net/trac/changeset/4209 Forgot version string U trunk/thirdparty/drakma/drakma.asd Modified: trunk/thirdparty/drakma/drakma.asd =================================================================== --- trunk/thirdparty/drakma/drakma.asd 2009-02-09 12:15:51 UTC (rev 4208) +++ trunk/thirdparty/drakma/drakma.asd 2009-02-09 13:43:39 UTC (rev 4209) @@ -38,7 +38,7 @@ (in-package :drakma-asd) -(defvar *drakma-version-string* "0.11.5" +(defvar *drakma-version-string* "1.0.0" "Drakma's version number as a string.") ;; we export its name so we can import it later From bknr at bknr.net Mon Feb 9 13:44:09 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 14:44:09 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/chunga.asd Message-ID: Revision: 4210 Author: edi URL: http://bknr.net/trac/changeset/4210 Forgot version string U trunk/thirdparty/chunga/chunga.asd Modified: trunk/thirdparty/chunga/chunga.asd =================================================================== --- trunk/thirdparty/chunga/chunga.asd 2009-02-09 13:43:39 UTC (rev 4209) +++ trunk/thirdparty/chunga/chunga.asd 2009-02-09 13:44:09 UTC (rev 4210) @@ -29,7 +29,7 @@ (asdf:defsystem :chunga :serial t - :version "0.4.3" + :version "1.0.0" :depends-on (:trivial-gray-streams) :components ((:file "packages") (:file "specials") From bknr at bknr.net Mon Feb 9 14:16:22 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 15:16:22 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4211 Author: edi URL: http://bknr.net/trac/changeset/4211 Tweak here and there U trunk/thirdparty/hunchentoot/CHANGELOG U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-09 13:44:09 UTC (rev 4210) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-09 14:16:22 UTC (rev 4211) @@ -1,3 +1,8 @@ +Version 1.0.0 +2009-02-10 +Architectural redesign (thanks to Hans H?bner) +Lots of small fixes and improvement, too many to enumerate here + Version 0.15.6 2008-04-09 Fixed embarrassingly mis-placed parentheses (thanks to Hans H?bner) Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-09 13:44:09 UTC (rev 4210) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-09 14:16:22 UTC (rev 4211) @@ -229,59 +229,69 @@ ((#\") (write-string "\\\"" out)) (otherwise (write-char char out))))))) -(defmacro upgrade-vector (vector new-type &key converter (new-length `(array-total-size ,vector))) - `(setf ,vector (loop - with new-vector = (make-array ,new-length - :element-type ,new-type - :fill-pointer (length vector)) - for i from 0 below (length ,vector) - do (setf (aref new-vector i) ,(if converter - `(funcall ,converter (aref ,vector i)) - `(aref ,vector i))) - finally (return new-vector)))) +(defmacro upgrade-vector (vector new-type &key converter) + "Returns a vector with the same length and the same elements as +VECTOR \(a variable holding a vector) but having element type +NEW-TYPE. If CONVERTER is not NIL, it should designate a function +which will be applied to each element of VECTOR before the result is +stored in the new vector. The resulting vector will have a fill +pointer set to its end. +The macro also uses SETQ to store the new vector in VECTOR." + `(setq ,vector + (loop with length = (length ,vector) + with new-vector = (make-array length + :element-type ,new-type + :fill-pointer length) + for i below length + do (setf (aref new-vector i) ,(if converter + `(funcall ,converter (aref ,vector i)) + `(aref ,vector i))) + finally (return new-vector)))) + (defun url-decode (string &optional (external-format *hunchentoot-default-external-format*)) "Decodes a URL-encoded STRING which is assumed to be encoded using the external format EXTERNAL-FORMAT." - (if (zerop (length string)) - "" - (loop - with vector = (make-array (length string) :element-type 'octet :fill-pointer 0) - with i = 0 - with unicode - for char = (aref string i) - do (labels ((decode-hex (length) - (prog1 - (parse-integer string :start i :end (+ i length) :radix 16) - (incf i length))) - (push-integer (integer) - (vector-push integer vector)) - (peek () - (aref string i)) - (advance () - (setf char (peek)) - (incf i))) - (cond - ((char= #\% char) - (advance) - (cond - ((char= #\u (peek)) - (unless unicode - (setf unicode t) - (upgrade-vector vector '(integer 0 65535))) - (advance) - (push-integer (decode-hex 4))) - (t - (push-integer (decode-hex 2))))) - (t - (push-integer (char-code (case char - ((#\+) #\Space) - (otherwise char)))) - (advance)))) - while (< i (length string)) - finally (return (if unicode - (upgrade-vector vector 'character :converter #'code-char) - (octets-to-string vector :external-format external-format)))))) + (when (zerop (length string)) + (return-from url-decode "")) + (let ((vector (make-array (length string) :element-type 'octet :fill-pointer 0)) + (i 0) + unicodep) + (loop + (unless (< i (length string)) + (return)) + (let ((char (aref string i))) + (labels ((decode-hex (length) + (prog1 + (parse-integer string :start i :end (+ i length) :radix 16) + (incf i length))) + (push-integer (integer) + (vector-push integer vector)) + (peek () + (aref string i)) + (advance () + (setq char (peek)) + (incf i))) + (cond + ((char= #\% char) + (advance) + (cond + ((char= #\u (peek)) + (unless unicodep + (setq unicodep t) + (upgrade-vector vector '(integer 0 65535))) + (advance) + (push-integer (decode-hex 4))) + (t + (push-integer (decode-hex 2))))) + (t + (push-integer (char-code (case char + ((#\+) #\Space) + (otherwise char)))) + (advance)))))) + (cond (unicodep + (upgrade-vector vector 'character :converter #'code-char)) + (t (octets-to-string vector :external-format external-format))))) (defun form-url-encoded-list-to-alist (form-url-encoded-list &optional (external-format *hunchentoot-default-external-format*)) From bknr at bknr.net Mon Feb 9 14:50:22 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 15:50:22 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/ Message-ID: Revision: 4212 Author: edi URL: http://bknr.net/trac/changeset/4212 Conditions U trunk/thirdparty/chunga/CHANGELOG.txt U trunk/thirdparty/chunga/chunga.asd U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp U trunk/thirdparty/chunga/read.lisp U trunk/thirdparty/chunga/streams.lisp Modified: trunk/thirdparty/chunga/CHANGELOG.txt =================================================================== --- trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-09 14:50:22 UTC (rev 4212) @@ -1,6 +1,7 @@ Version 1.0.0 2009-02-10 Switched to binary streams underneath and got rid of FLEXI-STREAMS dependency +Added conditions Exported (an improved version of) AS-KEYWORD Added WITH-CHARACTER-STREAM-SEMANTICS Modified: trunk/thirdparty/chunga/chunga.asd =================================================================== --- trunk/thirdparty/chunga/chunga.asd 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/chunga.asd 2009-02-09 14:50:22 UTC (rev 4212) @@ -35,6 +35,7 @@ (:file "specials") (:file "util") (:file "known-words") + (:file "conditions") (:file "read") (:file "streams") (:file "input") Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-09 14:50:22 UTC (rev 4212) @@ -72,6 +72,11 @@
  • Conditions
      +
    1. chunga-condition +
    2. chunga-error +
    3. chunga-warning +
    4. syntax-error +
    5. parameter-error
    6. input-chunking-body-corrupted
    7. input-chunking-unexpected-end-of-file
    @@ -342,9 +347,69 @@

    Conditions

    -Here are two conditions which might be signaled if something bad -happens while reading from a chunked stream: +Here are conditions which might be signalled if something bad happens +with a chunked stream. + + +


    [Condition] +
    chunga-condition + +


    +All conditions signalled by Chunga are of this type. This is a subtype of CONDITION. +
    + + + + + +


    [Error] +
    chunga-error + +


    +All errors signalled by Chunga are of this type. This is a subtype of CHUNGA-CONDITION and of +STREAM-ERROR, +so STREAM-ERROR-STREAM +can be used to access the offending stream. +
    + + + + + +


    [Warning] +
    chunga-warning + +


    +All warnings signalled by Chunga are of this type. This is a subtype of CHUNGA-CONDITION and of WARNING. +
    + + + + + +


    [Error] +
    syntax-error + +


    An error of this type is signalled if Chunga +encounters wrong or unknown syntax when reading data. This is a +subtype of CHUNGA-ERROR. +
    + + + + + +


    [Error] +
    parameter-error + +


    An error of this type is signalled if a function was +called with inconsistent or illegal parameters. This is a subtype +of CHUNGA-ERROR. +
    + + +


    [Condition type]
    input-chunking-body-corrupted @@ -353,11 +418,7 @@ A condition of this type is signaled if an unexpected character (octet) is read while reading from a chunked stream with input chunking enabled. This is a subtype of -STREAM-ERROR, -so STREAM-ERROR-STREAM -can be used to access the offending stream. +CHUNGA-ERROR. @@ -372,11 +433,7 @@ A condition of this type is signaled if we reach an unexpected EOF on a chunked stream with input chunking enabled. This is a subtype of -STREAM-ERROR, -so STREAM-ERROR-STREAM -can be used to access the offending stream. +CHUNGA-ERROR. Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-09 14:50:22 UTC (rev 4212) @@ -39,6 +39,8 @@ :assert-char :as-keyword :as-capitalized-string + :chunga-error + :chunga-warning :chunked-input-stream :chunked-input-stream-extensions :chunked-input-stream-trailers @@ -58,6 +60,7 @@ :read-name-value-pairs :read-token :skip-whitespace + :syntax-error :trim-whitespace :with-character-stream-semantics)) Modified: trunk/thirdparty/chunga/read.lisp =================================================================== --- trunk/thirdparty/chunga/read.lisp 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/read.lisp 2009-02-09 14:50:22 UTC (rev 4212) @@ -29,17 +29,23 @@ (in-package :chunga) -(defun signal-unexpected-chars (last-char expected-chars) +(defun signal-unexpected-chars (stream last-char expected-chars) "Signals an error that LAST-CHAR was read although one of -EXPECTED-CHARS was expected. \(Note that EXPECTED-CHARS, -despites its name, can also be a single character instead of a -list). Uses *CURRENT-ERROR-MESSAGE* if it's not NIL, or calls -*CURRENT-ERROR-FUNCTION* otherwise." +EXPECTED-CHARS was expected. \(Note that EXPECTED-CHARS, despites its +name, can also be a single character instead of a list). Calls +*CURRENT-ERROR-FUNCTION* if it's not NIL, or uses +*CURRENT-ERROR-MESSAGE* otherwise." (cond (*current-error-function* (funcall *current-error-function* last-char expected-chars)) - (*current-error-message* - (error "~@[~A~%~]~:[End of file~;Read character ~:*~S~], but expected ~:[a member of ~S~;~S~]." - *current-error-message* last-char (atom expected-chars) expected-chars)))) + (t + (error 'syntax-error + :stream stream + :format-control "~@[~A~%~]~:[End of file~;Read character ~:*~S~], ~ +but expected ~:[a member of ~S~;~S~]." + :format-arguments (list *current-error-message* + last-char + (atom expected-chars) + expected-chars))))) (defun charp (char) "Returns true if the Lisp character CHAR is a CHAR according to RFC 2616." @@ -73,7 +79,7 @@ character EXPECTED-CHAR. Signals an error otherwise." (let ((char (read-char* stream))) (unless (and char (char= char expected-char)) - (signal-unexpected-chars char expected-char)) + (signal-unexpected-chars stream char expected-char)) char)) (defun assert-crlf (stream) @@ -170,7 +176,10 @@ Returns NIL if LINE consists solely of whitespace." (unless (zerop (length (trim-whitespace line))) (let ((colon-pos (or (position #\: line :test #'char=) - (error "Couldn't find colon in header line ~S." line)))) + (error 'syntax-error + :stream stream + :format-control "Couldn't find colon in header line ~S." + :format-arguments (list line))))) (cons (as-keyword (subseq line 0 colon-pos)) (trim-whitespace (subseq line (1+ colon-pos))))))) (add-header (pair) @@ -231,7 +240,7 @@ (#\Return (assert-char stream #\Linefeed) (let ((char (read-char* stream))) (unless (whitespacep char) - (signal-unexpected-chars char '(#\Space #\Tab))))) + (signal-unexpected-chars stream char '(#\Space #\Tab))))) (otherwise (write-char char out)))))) (defun read-cookie-value (stream &key name separators) Modified: trunk/thirdparty/chunga/streams.lisp =================================================================== --- trunk/thirdparty/chunga/streams.lisp 2009-02-09 14:16:22 UTC (rev 4211) +++ trunk/thirdparty/chunga/streams.lisp 2009-02-09 14:50:22 UTC (rev 4212) @@ -110,40 +110,16 @@ (close real-stream :abort abort)) (t nil)))) -(define-condition input-chunking-unexpected-end-of-file (stream-error) - () - (:documentation "A condition of this type is signaled if we -reach an unexpected EOF on a chunked stream with input chunking -enabled. This is a subtype of STREAM-ERROR, so -STREAM-ERROR-STREAM can be used to access the offending -stream.")) - -(define-condition input-chunking-body-corrupted (stream-error) - ((last-char :initarg :last-char - :documentation "The \(unexpected) character which was read.") - (expected-chars :initarg :expected-chars - :documentation "The characters which were -expected. A list of characters or one single character.")) - (:report (lambda (condition stream) - (with-slots (last-char expected-chars) - condition - (format stream "Chunked stream ~S seems to be corrupted. -Read character ~S, but expected ~:[a member of ~S~;~S~]." - (stream-error-stream condition) - last-char (atom expected-chars) expected-chars)))) - (:documentation "A condition of this type is signaled if an -unexpected character \(octet) is read while reading from a -chunked stream with input chunking enabled. This is a subtype of -STREAM-ERROR, so STREAM-ERROR-STREAM can be used to access the -offending stream.")) - (defun make-chunked-stream (stream) "Creates and returns a chunked stream \(a stream of type CHUNKED-STREAM) which wraps STREAM. STREAM must be an open binary stream." (unless (and (streamp stream) (open-stream-p stream)) - (error "~S should have been an open stream." stream)) + (error 'parameter-error + :stream stream + :format-control "~S should have been an open stream." + :format-arguments (list stream))) (make-instance ;; actual type depends on STREAM (cond ((and (input-stream-p stream) (output-stream-p stream)) From bknr at bknr.net Mon Feb 9 14:52:07 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 15:52:07 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/input.lisp Message-ID: Revision: 4213 Author: edi URL: http://bknr.net/trac/changeset/4213 And this file as well U trunk/thirdparty/chunga/input.lisp Modified: trunk/thirdparty/chunga/input.lisp =================================================================== --- trunk/thirdparty/chunga/input.lisp 2009-02-09 14:50:22 UTC (rev 4212) +++ trunk/thirdparty/chunga/input.lisp 2009-02-09 14:52:07 UTC (rev 4213) @@ -54,8 +54,10 @@ chunk-extensions nil chunk-trailers nil)) (t (when (< input-index input-limit) - (error "Not all chunks from ~S have been read completely." - stream)))))) + (error 'parameter-error + :stream stream + :format-control "Not all chunks from ~S have been read completely." + :format-arguments (list stream))))))) (setf (slot-value stream 'input-chunking-p) new-value)) (defmethod stream-clear-input ((stream chunked-input-stream)) @@ -96,7 +98,10 @@ "Reads chunk extensions \(if there are any) and stores them into the corresponding slot of the stream." (when-let (extensions (read-name-value-pairs inner-stream)) - (warn "Adding uninterpreted extensions to stream ~S." stream) + (warn 'chunga-warning + :stream stream + :format-control "Adding uninterpreted extensions to stream ~S." + :format-arguments (list stream)) (setf (slot-value stream 'chunk-extensions) (append (chunked-input-stream-extensions stream) extensions))) (assert-crlf inner-stream)) From bknr at bknr.net Mon Feb 9 14:53:01 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 15:53:01 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 4214 Author: edi URL: http://bknr.net/trac/changeset/4214 Shadow Chunga symbols U trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/packages.lisp Modified: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp 2009-02-09 14:52:07 UTC (rev 4213) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 14:53:01 UTC (rev 4214) @@ -58,7 +58,8 @@ (define-condition parameter-error (drakma-simple-error) () - (:documentation "Signalled if a function was called with inconsistent or illegal parameters.")) + (:documentation "Signalled if a function was called with +inconsistent or illegal parameters.")) (defun parameter-error (format-control &rest format-arguments) "Signals an error of type PARAMETER-ERROR with the provided Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 14:52:07 UTC (rev 4213) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 14:53:01 UTC (rev 4214) @@ -33,6 +33,7 @@ (:use :cl :puri :flexi-streams :chunga) ;; the variable defined in the ASDF system definition (:import-from :drakma-asd :*drakma-version-string*) + (:shadow :syntax-error :parameter-error) (:export :*allow-dotless-cookie-domains-p* :*body-format-function* :*drakma-default-external-format* From bknr at bknr.net Mon Feb 9 14:57:39 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 15:57:39 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/doc/clixdoc.xsl Message-ID: Revision: 4215 Author: hans URL: http://bknr.net/trac/changeset/4215 checkpoint U trunk/thirdparty/hunchentoot/doc/clixdoc.xsl Modified: trunk/thirdparty/hunchentoot/doc/clixdoc.xsl =================================================================== --- trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-09 14:53:01 UTC (rev 4214) +++ trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-09 14:57:39 UTC (rev 4215) @@ -39,6 +39,8 @@ omit-xml-declaration="yes" doctype-public="-//W3C//DTD HTML 4.0 Strict//EN" /> + + @@ -50,6 +52,7 @@ pre { padding:5px; background-color:#e0e0e0 } pre.none { padding:5px; background-color:#ffffff } h3, h4, h5 { text-decoration: underline; } + .entry-type { padding-left: 1em; font-size: 60%; font-style: italic } a { text-decoration: none; padding: 1px 2px 1px 2px; } a:visited { text-decoration: none; padding: 1px 2px 1px 2px; } a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; } @@ -75,25 +78,15 @@

    - - [Generic function] - [Method] - [Macro] - [Function] - + []
    - - - - - - - - - => - - - + + + + + => + +

    @@ -102,11 +95,7 @@

    - - [Generic reader] - [Specialized reader] - [Reader] - + []
    @@ -128,11 +117,7 @@

    - - [Generic writer] - [Specialized writer] - [Writer] - + []
    @@ -154,11 +139,7 @@

    - - [Generic accessor] - [Specialized accessor] - [Accessor] - + []
    @@ -182,7 +163,8 @@

    - [Special variable]
    + [] +
    @@ -197,7 +179,8 @@

    - [Standard class]
    + [] +
    @@ -212,7 +195,8 @@

    - [Condition type]
    + [] +
    @@ -227,13 +211,9 @@

    - [Symbol]
    -     - - - - - + [] +
    +

    @@ -242,7 +222,8 @@

    - [Constant]
    + [] +
    @@ -355,12 +336,36 @@

    @@ -373,4 +378,66 @@     + + + + + + + - + + + + + + + + + + + + + + + + + + Generic function + Method + Macro + Function + + + + + Generic reader + Specialized reader + Reader + + + + + Generic writer + Specialized writer + Writer + + + + + Generic accessor + Specialized accessor + Accessor + + + Special variable + Standard class + Condition type + Symbol + Constant + + + + + + From bknr at bknr.net Mon Feb 9 15:25:05 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 09 Feb 2009 16:25:05 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/doc/clixdoc.xsl Message-ID: Revision: 4216 Author: hans URL: http://bknr.net/trac/changeset/4216 Reworked U trunk/thirdparty/hunchentoot/doc/clixdoc.xsl Modified: trunk/thirdparty/hunchentoot/doc/clixdoc.xsl =================================================================== --- trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-09 14:57:39 UTC (rev 4215) +++ trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-09 15:25:05 UTC (rev 4216) @@ -39,7 +39,7 @@ omit-xml-declaration="yes" doctype-public="-//W3C//DTD HTML 4.0 Strict//EN" /> - + @@ -78,9 +78,10 @@

    + []
    - + @@ -95,20 +96,16 @@

    + []
    - - - - - - - - - => - - - + + + + + => + +

    @@ -117,119 +114,48 @@

    + []
    - - - - - (setf ( - - ) new-value) - - => - - - -

    - -
    -

    -     - - -

    - [] -
    - - - - - - - + (setf ( + + ) new-value) + => -
    - (setf ( - - ) new-value) -     +

    - +

    + []
    - - - - - - -

    - -
    -

    -     - - -

    - [] + + + + => +
    - - - - - - + (setf ( + + ) new-value)

    - +

    - [] -
    - - - - - - -

    - -
    -

    -     - - -

    - [] -
    -

    - -
    -

    -     - - -

    []
    - - - - - - +

    @@ -237,10 +163,7 @@     - - - - +
    @@ -270,19 +193,6 @@     - - - - - - - # - - - - - - @@ -351,14 +261,15 @@ - +
    • - + +
      • @@ -378,6 +289,27 @@ + + + + + + + + # + + + + + + + + + + + + + @@ -394,10 +326,13 @@ - + + + + @@ -434,6 +369,7 @@ Condition type Symbol Constant + Constant From bknr at bknr.net Tue Feb 10 09:32:46 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 10:32:46 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/conditions.lisp Message-ID: Revision: 4217 Author: edi URL: http://bknr.net/trac/changeset/4217 Forgot this file A trunk/thirdparty/chunga/conditions.lisp Added: trunk/thirdparty/chunga/conditions.lisp =================================================================== --- trunk/thirdparty/chunga/conditions.lisp (rev 0) +++ trunk/thirdparty/chunga/conditions.lisp 2009-02-10 09:32:46 UTC (rev 4217) @@ -0,0 +1,84 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: ODD-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/odd-streams/conditions.lisp,v 1.5 2007/12/31 01:08:45 edi Exp $ + +;;; Copyright (c) 2008-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :chunga) + +(define-condition chunga-condition (condition) + () + (:documentation "Superclass for all conditions related to Chunga.")) + +(define-condition chunga-error (chunga-condition stream-error) + () + (:documentation "Superclass for all errors related to Chunga. This +is a subtype of STREAM-ERROR, so STREAM-ERROR-STREAM can be used to +access the offending stream.")) + +(define-condition chunga-simple-error (chunga-error simple-condition) + () + (:documentation "Like CHUNGA-ERROR but with formatting capabilities.")) + +(define-condition parameter-error (chunga-simple-error) + () + (:documentation "Signalled if a function was called with +inconsistent or illegal parameters.")) + +(define-condition syntax-error (chunga-simple-error) + () + (:documentation "Signalled if Chunga encounters wrong or unknown +syntax when reading data.")) + +(define-condition chunga-warning (chunga-condition warning) + () + (:documentation "Superclass for all warnings related to Chunga.")) + +(define-condition chunga-simple-warning (chunga-warning simple-condition) + () + (:documentation "Like CHUNGA-WARNING but with formatting capabilities.")) + +(define-condition input-chunking-unexpected-end-of-file (chunga-error) + () + (:documentation "A condition of this type is signaled if we reach an +unexpected EOF on a chunked stream with input chunking enabled.")) + +(define-condition input-chunking-body-corrupted (chunga-error) + ((last-char :initarg :last-char + :documentation "The \(unexpected) character which was read.") + (expected-chars :initarg :expected-chars + :documentation "The characters which were expected. +A list of characters or one single character.")) + (:report (lambda (condition stream) + (with-slots (last-char expected-chars) + condition + (format stream "Chunked stream ~S seems to be corrupted. +Read character ~S, but expected ~:[a member of ~S~;~S~]." + (stream-error-stream condition) + last-char (atom expected-chars) expected-chars)))) + (:documentation "A condition of this type is signaled if an +unexpected character \(octet) is read while reading from a chunked +stream with input chunking enabled.")) From bknr at bknr.net Tue Feb 10 10:28:58 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:28:58 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4218 Author: edi URL: http://bknr.net/trac/changeset/4218 Rename, part 1 U trunk/thirdparty/hunchentoot/connection-manager.lisp U trunk/thirdparty/hunchentoot/server.lisp U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 09:32:46 UTC (rev 4217) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 10:28:58 UTC (rev 4218) @@ -29,46 +29,46 @@ (in-package :hunchentoot) -;;; The connection-manager protocol defines how Hunchentoot schedules +;;; The connection-dispatcher protocol defines how Hunchentoot schedules ;;; request execution to worker threads or for inline execution. -(defclass connection-manager () +(defclass connection-dispatcher () ((server :initarg :server :reader server :documentation "The Hunchentoot server instance that this -connection manager works for.")) - (:documentation "Base class for all connection managers classes. +connection dispatcher works for.")) + (:documentation "Base class for all connection dispatchers classes. Its purpose is to carry the back pointer to the server instance.")) -(defgeneric execute-acceptor (connection-manager) +(defgeneric execute-acceptor (connection-dispatcher) (:documentation "This function is called once Hunchentoot has performed all initial processing to start listening for incoming connections. It does so by calling the ACCEPT-CONNECTIONS functions of the server, taken from -the SERVER slot of the connection manager instance. +the SERVER slot of the connection dispatcher instance. -In a multi-threaded environment, the connection manager starts a new +In a multi-threaded environment, the connection dispatcher starts a new thread and calls THUNK in that thread. In a single-threaded environment, the thunk will be called directly.")) -(defgeneric handle-incoming-connection (connection-manager socket) +(defgeneric handle-incoming-connection (connection-dispatcher socket) (:documentation "This function is called by Hunchentoot to start processing of requests on a new incoming connection. SOCKET is the usocket instance that represents the new connection \(or a socket handle on LispWorks). -The connection manager starts processing requests on the incoming +The connection dispatcher starts processing requests on the incoming connection by calling the START-REQUEST-PROCESSING function of the -server instance, taken from the SERVER slot in the connection manager +server instance, taken from the SERVER slot in the connection dispatcher instance. The SOCKET argument is passed to START-REQUEST-PROCESSING as argument. -In a multi-threaded environment, the connection manager runs this function +In a multi-threaded environment, the connection dispatcher runs this function in a separate thread. In a single-threaded environment, this function is called directly.")) -(defgeneric shutdown (connection-manager) +(defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated -with the connection manager, if any.") +with the connection dispatcher, if any.") (:method ((manager t)) #+:lispworks (when-let (acceptor (server-acceptor (server manager))) @@ -76,27 +76,27 @@ ;; COMM:START-UP-SERVER (mp:process-kill acceptor)))) -(defclass single-threaded-connection-manager (connection-manager) +(defclass single-threaded-connection-dispatcher (connection-dispatcher) () - (:documentation "Connection manager that runs synchronously in the + (:documentation "Connection Dispatcher that runs synchronously in the thread that invoked the START-SERVER function.")) -(defmethod execute-acceptor ((manager single-threaded-connection-manager)) +(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) (accept-connections (server manager))) -(defmethod handle-incoming-connection ((manager single-threaded-connection-manager) socket) +(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) (process-connection (server manager) socket)) -(defclass one-thread-per-connection-manager (connection-manager) +(defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process :documentation "Process that accepts incoming connections and dispatches them to new processes for request execution.")) - (:documentation "Connection manager that starts one thread for + (:documentation "Connection Dispatcher that starts one thread for listening to incoming requests and one thread for each incoming connection.")) -(defmethod execute-acceptor ((manager one-thread-per-connection-manager)) +(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) #+:lispworks (accept-connections (server manager)) #-:lispworks @@ -108,13 +108,13 @@ (server-port (server manager)))))) #-:lispworks -(defmethod shutdown ((manager one-thread-per-connection-manager)) +(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) (loop while (bt:thread-alive-p (acceptor-process manager)) do (sleep 1))) #+:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-manager) handle) +(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* @@ -137,7 +137,7 @@ port)))) #-:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-manager) socket) +(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) (bt:make-thread (lambda () (process-connection (server manager) socket)) :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 09:32:46 UTC (rev 4217) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:28:58 UTC (rev 4218) @@ -74,10 +74,10 @@ specified in (fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts.") - (connection-manager :initarg :connection-manager + (connection-dispatcher :initarg :connection-dispatcher :initform nil - :reader server-connection-manager - :documentation "The connection manager that is + :reader server-connection-dispatcher + :documentation "The connection dispatcher that is responsible for listening to new connections and scheduling them for execution.") #+:lispworks @@ -125,8 +125,8 @@ information about a running Hunchentoot server instance.")) (defmethod initialize-instance :after ((server server) - &key connection-manager-class - connection-manager-arguments + &key connection-dispatcher-class + connection-dispatcher-arguments (threaded *supports-threads-p* threaded-specified-p) (persistent-connections-p threaded @@ -136,12 +136,12 @@ connection-timeout-provided-p) (read-timeout nil read-timeout-provided-p) (write-timeout nil write-timeout-provided-p)) - "The CONNECTION-MANAGER-CLASS and CONNECTION-MANAGER-ARGUMENTS + "The CONNECTION-DISPATCHER-CLASS and CONNECTION-DISPATCHER-ARGUMENTS arguments to the creation of a server instance determine the -connection manager instance that is created. THREADED is the user -friendly version of the CONNECTION-MANAGER-CLASS option. If it is -NIL, an unthreaded connection manager is used. It is an error to -specify both THREADED and a CONNECTION-MANAGER-CLASS argument. +connection dispatcher instance that is created. THREADED is the user +friendly version of the CONNECTION-DISPATCHER-CLASS option. If it is +NIL, an unthreaded connection dispatcher is used. It is an error to +specify both THREADED and a CONNECTION-DISPATCHER-CLASS argument. The PERSISTENT-CONNECTIONS-P keyword argument defaults to the value of the THREADED keyword argument but can be overridden. @@ -151,19 +151,19 @@ value. If either of READ-TIMEOUT or WRITE-TIMEOUT is specified, CONNECTION-TIMEOUT is not used and may not be supplied." (declare (ignore read-timeout write-timeout)) - (when (and threaded-specified-p connection-manager-class) - (parameter-error "Can't use both THREADED and CONNECTION-MANAGER-CLASS arguments.")) + (when (and threaded-specified-p connection-dispatcher-class) + (parameter-error "Can't use both THREADED and CONNECTION-DISPATCHER-CLASS arguments.")) (unless persistent-connections-specified-p (setf (server-persistent-connections-p server) persistent-connections-p)) - (unless (server-connection-manager server) - (setf (slot-value server 'connection-manager) + (unless (server-connection-dispatcher server) + (setf (slot-value server 'connection-dispatcher) (apply #'make-instance - (or connection-manager-class + (or connection-dispatcher-class (if threaded - 'one-thread-per-connection-manager - 'single-threaded-connection-manager)) + 'one-thread-per-connection-dispatcher + 'single-threaded-connection-dispatcher)) :server server - connection-manager-arguments))) + connection-dispatcher-arguments))) (if (or read-timeout-provided-p write-timeout-provided-p) (when connection-timeout-provided-p (parameter-error "Can't have both CONNECTION-TIMEOUT and either of READ-TIMEOUT and WRITE-TIMEOUT.")) @@ -196,13 +196,13 @@ connections.") (:method ((server server)) (start-listening server) - (execute-acceptor (server-connection-manager server)))) + (execute-acceptor (server-connection-dispatcher server)))) (defgeneric stop (server) (:documentation "Stop the SERVER so that it does no longer accept requests.") (:method ((server server)) (setf (server-shutdown-p server) t) - (shutdown (server-connection-manager server)) + (shutdown (server-connection-dispatcher server)) #-:lispworks (usocket:socket-close (server-listen-socket server)))) @@ -274,7 +274,7 @@ and not all implementations provide for separate read and write timeout parameter setting. -CONNECTION-MANAGER-CLASS specifies the name of the class to instantiate +CONNECTION-DISPATCHER-CLASS specifies the name of the class to instantiate for managing how connections are mapped to threads. You don't normally want to specify this argument unless you want to have non-standard threading behavior. See the documentation for more information. @@ -340,12 +340,8 @@ "Stops the Hunchentoot server SERVER." (stop server)) -;; connection manager API +;; connection dispatcher API -(defconstant +new-connection-wait-time+ 2 - "Time in seconds to wait for a new connection to arrive before -performing a cleanup run.") - (defgeneric start-listening (server) (:documentation "Sets up a listen socket for the given SERVER and enables it to listen for incoming connections. This function is @@ -370,7 +366,7 @@ :function (lambda (handle) (unless (server-shutdown-p server) (handle-incoming-connection - (server-connection-manager server) handle))) + (server-connection-dispatcher server) handle))) ;; wait until the server was successfully started ;; or an error condition is returned :wait t) @@ -388,7 +384,7 @@ (defgeneric accept-connections (server) (:documentation "In a loop, accepts a connection and -dispatches it to the server's connection manager object for processing +dispatches it to the server's connection dispatcher object for processing using HANDLE-INCOMING-CONNECTION.") (:method ((server server)) #+:lispworks @@ -403,7 +399,7 @@ (set-timeouts client-connection (server-read-timeout server) (server-write-timeout server)) - (handle-incoming-connection (server-connection-manager server) + (handle-incoming-connection (server-connection-dispatcher server) client-connection)) ;; ignore condition (usocket:connection-aborted-error ())))))) @@ -445,7 +441,7 @@ finally (setf (return-code reply) +http-not-found+)))) (defgeneric process-connection (server socket) - (:documentation "This function is called by the connection manager + (:documentation "This function is called by the connection dispatcher when a new client connection has been established. Arguments are the SERVER object and a usocket socket stream object \(or a LispWorks socket handle) in SOCKET. It reads the request headers and hands over Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 09:32:46 UTC (rev 4217) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:28:58 UTC (rev 4218) @@ -327,6 +327,10 @@ #+:lispworks t #-:lispworks bt:*supports-threads-p*) +(defconstant +new-connection-wait-time+ 2 + "Time in seconds to wait for a new connection to arrive before +performing a cleanup run.") + (pushnew :hunchentoot *features*) ;; stuff for Nikodemus Siivola's HYPERDOC From bknr at bknr.net Tue Feb 10 10:30:10 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:30:10 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4219 Author: edi URL: http://bknr.net/trac/changeset/4219 Rename, part 2 A trunk/thirdparty/hunchentoot/connection-dispatcher.lisp D trunk/thirdparty/hunchentoot/connection-manager.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd Copied: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp (from rev 4218, trunk/thirdparty/hunchentoot/connection-manager.lisp) =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp (rev 0) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 10:30:10 UTC (rev 4219) @@ -0,0 +1,143 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; $Header$ + +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :hunchentoot) + +;;; The connection-dispatcher protocol defines how Hunchentoot schedules +;;; request execution to worker threads or for inline execution. + +(defclass connection-dispatcher () + ((server :initarg :server + :reader server + :documentation "The Hunchentoot server instance that this +connection dispatcher works for.")) + (:documentation "Base class for all connection dispatchers classes. +Its purpose is to carry the back pointer to the server instance.")) + +(defgeneric execute-acceptor (connection-dispatcher) + (:documentation + "This function is called once Hunchentoot has performed all initial +processing to start listening for incoming connections. It does so by +calling the ACCEPT-CONNECTIONS functions of the server, taken from +the SERVER slot of the connection dispatcher instance. + +In a multi-threaded environment, the connection dispatcher starts a new +thread and calls THUNK in that thread. In a single-threaded +environment, the thunk will be called directly.")) + +(defgeneric handle-incoming-connection (connection-dispatcher socket) + (:documentation + "This function is called by Hunchentoot to start processing of +requests on a new incoming connection. SOCKET is the usocket instance +that represents the new connection \(or a socket handle on LispWorks). +The connection dispatcher starts processing requests on the incoming +connection by calling the START-REQUEST-PROCESSING function of the +server instance, taken from the SERVER slot in the connection dispatcher +instance. The SOCKET argument is passed to START-REQUEST-PROCESSING +as argument. + +In a multi-threaded environment, the connection dispatcher runs this function +in a separate thread. In a single-threaded environment, this function +is called directly.")) + +(defgeneric shutdown (connection-dispatcher) + (:documentation "Terminate all threads that are currently associated +with the connection dispatcher, if any.") + (:method ((manager t)) + #+:lispworks + (when-let (acceptor (server-acceptor (server manager))) + ;; kill the main acceptor process, see LW documentation for + ;; COMM:START-UP-SERVER + (mp:process-kill acceptor)))) + +(defclass single-threaded-connection-dispatcher (connection-dispatcher) + () + (:documentation "Connection Dispatcher that runs synchronously in the +thread that invoked the START-SERVER function.")) + +(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) + (accept-connections (server manager))) + +(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) + (process-connection (server manager) socket)) + +(defclass one-thread-per-connection-dispatcher (connection-dispatcher) + ((acceptor-process :accessor acceptor-process + :documentation "Process that accepts incoming + connections and dispatches them to new processes + for request execution.")) + (:documentation "Connection Dispatcher that starts one thread for +listening to incoming requests and one thread for each incoming +connection.")) + +(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) + #+:lispworks + (accept-connections (server manager)) + #-:lispworks + (setf (acceptor-process manager) + (bt:make-thread (lambda () + (accept-connections (server manager))) + :name (format nil "Hunchentoot acceptor \(~A:~A)" + (or (server-address (server manager)) "*") + (server-port (server manager)))))) + +#-:lispworks +(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) + (loop + while (bt:thread-alive-p (acceptor-process manager)) + do (sleep 1))) + +#+:lispworks +(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) + (incf *worker-counter*) + ;; check if we need to perform a global GC + (when (and *cleanup-interval* + (zerop (mod *worker-counter* *cleanup-interval*))) + (when *cleanup-function* + (funcall *cleanup-function*))) + (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})" + (multiple-value-list + (get-peer-address-and-port handle))) + nil #'process-connection + (server manager) handle)) + +#-:lispworks +(defun client-as-string (socket) + (let ((address (usocket:get-peer-address socket)) + (port (usocket:get-peer-port socket))) + (when (and address port) + (format nil "~A:~A" + (usocket:vector-quad-to-dotted-quad address) + port)))) + +#-:lispworks +(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) + (bt:make-thread (lambda () + (process-connection (server manager) socket)) + :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Deleted: trunk/thirdparty/hunchentoot/connection-manager.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 10:28:58 UTC (rev 4218) +++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 10:30:10 UTC (rev 4219) @@ -1,143 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- -;;; $Header$ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -;;; The connection-dispatcher protocol defines how Hunchentoot schedules -;;; request execution to worker threads or for inline execution. - -(defclass connection-dispatcher () - ((server :initarg :server - :reader server - :documentation "The Hunchentoot server instance that this -connection dispatcher works for.")) - (:documentation "Base class for all connection dispatchers classes. -Its purpose is to carry the back pointer to the server instance.")) - -(defgeneric execute-acceptor (connection-dispatcher) - (:documentation - "This function is called once Hunchentoot has performed all initial -processing to start listening for incoming connections. It does so by -calling the ACCEPT-CONNECTIONS functions of the server, taken from -the SERVER slot of the connection dispatcher instance. - -In a multi-threaded environment, the connection dispatcher starts a new -thread and calls THUNK in that thread. In a single-threaded -environment, the thunk will be called directly.")) - -(defgeneric handle-incoming-connection (connection-dispatcher socket) - (:documentation - "This function is called by Hunchentoot to start processing of -requests on a new incoming connection. SOCKET is the usocket instance -that represents the new connection \(or a socket handle on LispWorks). -The connection dispatcher starts processing requests on the incoming -connection by calling the START-REQUEST-PROCESSING function of the -server instance, taken from the SERVER slot in the connection dispatcher -instance. The SOCKET argument is passed to START-REQUEST-PROCESSING -as argument. - -In a multi-threaded environment, the connection dispatcher runs this function -in a separate thread. In a single-threaded environment, this function -is called directly.")) - -(defgeneric shutdown (connection-dispatcher) - (:documentation "Terminate all threads that are currently associated -with the connection dispatcher, if any.") - (:method ((manager t)) - #+:lispworks - (when-let (acceptor (server-acceptor (server manager))) - ;; kill the main acceptor process, see LW documentation for - ;; COMM:START-UP-SERVER - (mp:process-kill acceptor)))) - -(defclass single-threaded-connection-dispatcher (connection-dispatcher) - () - (:documentation "Connection Dispatcher that runs synchronously in the -thread that invoked the START-SERVER function.")) - -(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) - (accept-connections (server manager))) - -(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) - (process-connection (server manager) socket)) - -(defclass one-thread-per-connection-dispatcher (connection-dispatcher) - ((acceptor-process :accessor acceptor-process - :documentation "Process that accepts incoming - connections and dispatches them to new processes - for request execution.")) - (:documentation "Connection Dispatcher that starts one thread for -listening to incoming requests and one thread for each incoming -connection.")) - -(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) - #+:lispworks - (accept-connections (server manager)) - #-:lispworks - (setf (acceptor-process manager) - (bt:make-thread (lambda () - (accept-connections (server manager))) - :name (format nil "Hunchentoot acceptor \(~A:~A)" - (or (server-address (server manager)) "*") - (server-port (server manager)))))) - -#-:lispworks -(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) - (loop - while (bt:thread-alive-p (acceptor-process manager)) - do (sleep 1))) - -#+:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) - (incf *worker-counter*) - ;; check if we need to perform a global GC - (when (and *cleanup-interval* - (zerop (mod *worker-counter* *cleanup-interval*))) - (when *cleanup-function* - (funcall *cleanup-function*))) - (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})" - (multiple-value-list - (get-peer-address-and-port handle))) - nil #'process-connection - (server manager) handle)) - -#-:lispworks -(defun client-as-string (socket) - (let ((address (usocket:get-peer-address socket)) - (port (usocket:get-peer-port socket))) - (when (and address port) - (format nil "~A:~A" - (usocket:vector-quad-to-dotted-quad address) - port)))) - -#-:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) - (bt:make-thread (lambda () - (process-connection (server manager) socket)) - :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:28:58 UTC (rev 4218) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:30:10 UTC (rev 4219) @@ -78,7 +78,7 @@ #+(and :sbcl :unix (not :win32)) (:file "unix-sbcl") #+(and (not (or :allegro :clisp :cmu :lispworks :openmcl :sbcl)) :unix) (:file "unix-other") (:file "set-timeouts") - (:file "connection-manager") + (:file "connection-dispatcher") (:file "server") #-:hunchentoot-no-ssl (:file "ssl"))) From bknr at bknr.net Tue Feb 10 10:31:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:31:33 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/server.lisp Message-ID: Revision: 4220 Author: edi URL: http://bknr.net/trac/changeset/4220 Remove setuid/setgid stuff U trunk/thirdparty/hunchentoot/server.lisp Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:30:10 UTC (rev 4219) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:31:33 UTC (rev 4220) @@ -212,8 +212,6 @@ input-chunking-p connection-timeout persistent-connections-p read-timeout write-timeout - #+(and :unix (not :win32)) setuid - #+(and :unix (not :win32)) setgid #-:hunchentoot-no-ssl #-:hunchentoot-no-ssl #-:hunchentoot-no-ssl ssl-certificate-file ssl-privatekey-file ssl-privatekey-password access-logger) @@ -279,12 +277,6 @@ want to specify this argument unless you want to have non-standard threading behavior. See the documentation for more information. -On Unix you can use SETUID and SETGID to change the UID and GID of the -process directly after the server has been started. \(You might want -to do this if you're using a privileged port like 80.) SETUID and -SETGID can be integers \(the actual IDs) or strings \(for the user and -group name respectively). - MESSAGE-LOGGER is a designator for a function to call to log messages by the server. It must accept a severity level for the message \(one of :INFO, :WARNING, or :ERROR), a format string, and an arbitary @@ -322,18 +314,6 @@ 'server args))) (start server) - #+(and :unix (not :win32)) - (when setgid - ;; we must make sure to call setgid before we call setuid or - ;; suddenly we aren't root anymore... - (etypecase setgid - (integer (setgid setgid)) - (string (setgid (get-gid-from-name setgid))))) - #+(and :unix (not :win32)) - (when setuid - (etypecase setuid - (integer (setuid setuid)) - (string (setuid (get-uid-from-name setuid))))) server)) (defun stop-server (server) From bknr at bknr.net Tue Feb 10 10:32:09 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:32:09 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4221 Author: edi URL: http://bknr.net/trac/changeset/4221 Remove Unix files U trunk/thirdparty/hunchentoot/hunchentoot.asd D trunk/thirdparty/hunchentoot/unix-acl.lisp D trunk/thirdparty/hunchentoot/unix-clisp.lisp D trunk/thirdparty/hunchentoot/unix-cmu.lisp D trunk/thirdparty/hunchentoot/unix-lw.lisp D trunk/thirdparty/hunchentoot/unix-mcl.lisp D trunk/thirdparty/hunchentoot/unix-other.lisp D trunk/thirdparty/hunchentoot/unix-sbcl.lisp Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:32:09 UTC (rev 4221) @@ -70,13 +70,6 @@ (:file "easy-handlers") (:file "headers") (:file "get-backtrace") - #+(and :allegro :unix) (:file "unix-acl") - #+(and :clisp :unix) (:file "unix-clisp") - #+(and :cmu :unix) (:file "unix-cmu") - #+(and :lispworks :unix) (:file "unix-lw") - #+(and :openmcl :unix) (:file "unix-mcl") - #+(and :sbcl :unix (not :win32)) (:file "unix-sbcl") - #+(and (not (or :allegro :clisp :cmu :lispworks :openmcl :sbcl)) :unix) (:file "unix-other") (:file "set-timeouts") (:file "connection-dispatcher") (:file "server") Deleted: trunk/thirdparty/hunchentoot/unix-acl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-acl.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-acl.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,53 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-acl.lisp,v 1.6 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (require "osi")) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (excl.osi:setuid uid)) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (excl.osi:setgid gid)) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (excl.osi:pwent-uid (or (excl.osi:getpwnam name) - (parameter-error "User ~S not found." name)))) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (excl.osi:grent-gid (or (excl.osi:getgrnam name) - (parameter-error "Group ~S not found." name)))) Deleted: trunk/thirdparty/hunchentoot/unix-clisp.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-clisp.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-clisp.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,51 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10; -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-clisp.lisp,v 1.3 2008/02/13 16:03:10 edi Exp $ - -;;; Copyright (c) 2006, Luis Oliveira . -;;; Copyright (c) 2007, Anton Vodonosov . -;;; Copyright (c) 2007-2008, Dr. Edmund Weitz. -;;; All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (setf (posix:getuid) uid)) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (setf (posix:getgid) gid)) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (posix:user-info-uid (posix:user-info name))) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (posix:user-info-gid (posix:user-info name))) Deleted: trunk/thirdparty/hunchentoot/unix-cmu.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-cmu.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-cmu.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,54 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-cmu.lisp,v 1.6 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (multiple-value-bind (return-value errno) - (unix:unix-setuid uid) - (unless (and return-value (zerop return-value)) - (parameter-error "setuid failed: ~A" (unix:get-unix-error-msg errno))))) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (multiple-value-bind (return-value errno) - (unix:unix-setgid gid) - (unless (and return-value (zerop return-value)) - (parameter-error "setgid failed: ~A" (unix:get-unix-error-msg errno))))) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (unix:user-info-uid (unix:unix-getpwnam name))) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (unix:group-info-gid (unix:unix-getgrnam name))) Deleted: trunk/thirdparty/hunchentoot/unix-lw.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-lw.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-lw.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,93 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-lw.lisp,v 1.5 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(fli:define-foreign-function (%setuid "setuid") - ((uid :int)) - :result-type :int) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (unless (zerop (%setuid uid)) - (parameter-error "setuid failed: ~A" (lw:get-unix-error (lw:errno-value))))) - -(fli:define-foreign-function (%setgid "setgid") - ((gid :int)) - :result-type :int) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (unless (zerop (%setgid gid)) - (parameter-error "setgid failed: ~A" (lw:get-unix-error (lw:errno-value))))) - -(fli:define-c-struct passwd - (name (:pointer :char)) - (passwd (:pointer :char)) - (uid :int) - (gid :int) - (gecos (:pointer :char)) - (dir (:pointer :char)) - (shell (:pointer :char))) - -(fli:define-foreign-function (getpwnam "getpwnam") - ((name (:reference-pass :ef-mb-string))) - :result-type (:pointer passwd)) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (let ((passwd (getpwnam name))) - (when (fli:null-pointer-p passwd) - (let ((errno (lw:errno-value))) - (cond ((zerop errno) - (parameter-error "User ~S not found." name)) - (t (parameter-error "getpwnam failed: ~A" (lw:get-unix-error errno)))))) - (fli:foreign-slot-value passwd 'uid))) - -(fli:define-c-struct group - (name (:pointer :char)) - (passwd (:pointer :char)) - (gid :int) - (mem (:pointer (:pointer :char)))) - -(fli:define-foreign-function (getgrnam "getgrnam") - ((name (:reference-pass :ef-mb-string))) - :result-type (:pointer group)) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (let ((group (getgrnam name))) - (when (fli:null-pointer-p group) - (let ((errno (lw:errno-value))) - (cond ((zerop errno) - (parameter-error "Group ~S not found." name)) - (t (parameter-error "getgrnam failed: ~A" (lw:get-unix-error errno)))))) - (fli:foreign-slot-value group 'gid))) \ No newline at end of file Deleted: trunk/thirdparty/hunchentoot/unix-mcl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-mcl.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-mcl.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,54 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-mcl.lisp,v 1.7 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (let ((errno (ccl::setuid uid))) - (unless (zerop errno) - (parameter-error "setuid failed with errno ~A." errno)))) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (let ((errno (ccl::setgid gid))) - (unless (zerop errno) - (parameter-error "setgid failed with errno ~A." errno)))) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (declare (ignore name)) - (not-implemented 'get-uid-from-name)) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (declare (ignore name)) - (not-implemented 'get-gid-from-name)) Deleted: trunk/thirdparty/hunchentoot/unix-other.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-other.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-other.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,50 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-lw.lisp,v 1.5 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(defun setuid (uid) - "Stub." - (declare (ignore uid)) - (not-implemented 'setuid)) - -(defun setgid (gid) - "Stub." - (declare (ignore gid)) - (not-implemented 'setgid)) - -(defun get-uid-from-name (name) - "Stub." - (declare (ignore name)) - (not-implemented 'get-uid-from-name)) - -(defun get-gid-from-name (name) - "Stub." - (declare (ignore name)) - (not-implemented 'get-gid-from-name)) Deleted: trunk/thirdparty/hunchentoot/unix-sbcl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/unix-sbcl.lisp 2009-02-10 10:31:33 UTC (rev 4220) +++ trunk/thirdparty/hunchentoot/unix-sbcl.lisp 2009-02-10 10:32:09 UTC (rev 4221) @@ -1,57 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/unix-sbcl.lisp,v 1.8 2008/02/13 16:02:19 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (when (and (eq (nth-value 1 (find-symbol "GETGRNAM" :sb-posix)) :external) - (eq (nth-value 1 (find-symbol "GROUP-GID" :sb-posix)) :external)) - (pushnew :sb-posix-has-getgrnam *features*))) - -(defun setuid (uid) - "Sets the effective user ID of the current process to UID - see -setuid\(2)." - (sb-posix:setuid uid)) - -(defun setgid (gid) - "Sets the effective group ID of the current process to GID - -see setgid\(2)." - (sb-posix:setgid gid)) - -(defun get-uid-from-name (name) - "Returns the UID for the user named NAME." - (sb-posix:passwd-uid (sb-posix:getpwnam name))) - -(defun get-gid-from-name (name) - "Returns the GID for the group named NAME." - (declare (ignorable name)) - #+:sb-posix-has-getgrnam - (sb-posix:group-gid (sb-posix:getgrnam name)) - #-:sb-posix-has-getgrnam - (hunchentoot-error "You need a version of SBCL with SB-POSIX:GETGRNAM \(1.0.10.31 or higher).")) From bknr at bknr.net Tue Feb 10 10:45:45 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:45:45 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4222 Author: edi URL: http://bknr.net/trac/changeset/4222 Get rid of backtraces D trunk/thirdparty/hunchentoot/get-backtrace.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/server.lisp U trunk/thirdparty/hunchentoot/specials.lisp Deleted: trunk/thirdparty/hunchentoot/get-backtrace.lisp =================================================================== --- trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-10 10:32:09 UTC (rev 4221) +++ trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-10 10:45:45 UTC (rev 4222) @@ -1,125 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/hunchentoot/port-cmu.lisp,v 1.12 2008/04/08 14:39:18 edi Exp $ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -#+cmu -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces. It accepts a condition object ERROR and -returns a string with the corresponding backtrace." - (declare (ignore error)) - (with-output-to-string (s) - (let ((debug:*debug-print-level* nil) - (debug:*debug-print-length* nil)) - (debug:backtrace most-positive-fixnum s)))) - -#+allegro -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces. It accepts a condition object ERROR and -returns a string with the corresponding backtrace." - (with-output-to-string (s) - (with-standard-io-syntax - (let ((*print-readably* nil) - (*print-miser-width* 40) - (*print-pretty* t) - (tpl:*zoom-print-circle* t) - (tpl:*zoom-print-level* nil) - (tpl:*zoom-print-length* nil)) - (ignore-errors - (format *terminal-io* "~ -~@~%~%" - error)) - (ignore-errors - (let ((*terminal-io* s) - (*standard-output* s)) - (tpl:do-command "zoom" - :from-read-eval-print-loop nil - :count t - :all t))))))) - -#+openmcl -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces. It accepts a condition object ERROR and -returns a string with the corresponding backtrace." - (with-output-to-string (s) - (let ((*debug-io* s)) - (format *terminal-io* "~ -~@~%~%" - error) - (ccl:print-call-history :detailed-p nil)))) - -#+clisp -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces." - (declare (ignore error)) - (with-output-to-string (stream) - (system::print-backtrace :out stream))) - -#+lispworks -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces. It accepts a condition object ERROR and -returns a string with the corresponding backtrace." - (declare (ignore error)) - (with-output-to-string (s) - (let ((dbg::*debugger-stack* (dbg::grab-stack nil :how-many most-positive-fixnum)) - (*debug-io* s) - (dbg:*debug-print-level* nil) - (dbg:*debug-print-length* nil)) - (dbg:bug-backtrace nil)))) - - -;; determine how we're going to access the backtrace in the next -;; function -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (when (find-symbol "*DEBUG-PRINT-VARIABLE-ALIST*" :sb-debug) - (pushnew :hunchentoot-sbcl-debug-print-variable-alist *features*))) - -#+sbcl -(defun get-backtrace (error) - "This is the function that is used internally by Hunchentoot to -show or log backtraces. It accepts a condition object ERROR and -returns a string with the corresponding backtrace." - (declare (ignore error)) - (with-output-to-string (s) - #+:hunchentoot-sbcl-debug-print-variable-alist - (let ((sb-debug:*debug-print-variable-alist* - (list* '(*print-level* . nil) - '(*print-length* . nil) - sb-debug:*debug-print-variable-alist*))) - (sb-debug:backtrace most-positive-fixnum s)) - #-:hunchentoot-sbcl-debug-print-variable-alist - (let ((sb-debug:*debug-print-level* nil) - (sb-debug:*debug-print-length* nil)) - (sb-debug:backtrace most-positive-fixnum s)))) \ No newline at end of file Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:32:09 UTC (rev 4221) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:45:45 UTC (rev 4222) @@ -69,7 +69,6 @@ (:file "misc") (:file "easy-handlers") (:file "headers") - (:file "get-backtrace") (:file "set-timeouts") (:file "connection-dispatcher") (:file "server") Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:32:09 UTC (rev 4221) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:45:45 UTC (rev 4222) @@ -56,7 +56,6 @@ "*LISP-ERRORS-LOG-LEVEL*" "*LISP-WARNINGS-LOG-LEVEL*" "*LISTENER*" - "*LOG-LISP-BACKTRACES-P*" "*LOG-LISP-ERRORS-P*" "*LOG-LISP-WARNINGS-P*" "*METHODS-FOR-POST-PARAMETERS*" @@ -69,7 +68,6 @@ "*SESSION-GC-FREQUENCY*" "*SESSION-MAX-TIME*" "*SESSION-REMOVAL-HOOK*" - "*SHOW-LISP-BACKTRACES-P*" "*SHOW-LISP-ERRORS-P*" "*TMP-DIRECTORY*" "*USE-REMOTE-ADDR-FOR-SESSIONS*" @@ -145,7 +143,6 @@ "DISPATCH-REQUEST" "DO-SESSIONS" "ESCAPE-FOR-HTML" - "GET-BACKTRACE" "GET-PARAMETER" "GET-PARAMETERS" "GET-PARAMETERS*" Modified: trunk/thirdparty/hunchentoot/server.lisp =================================================================== --- trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:32:09 UTC (rev 4221) +++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:45:45 UTC (rev 4222) @@ -499,25 +499,13 @@ using START-OUTPUT. If all goes as planned, the function returns T." (let (*tmp-files* *headers-sent*) (unwind-protect - (let* ((*request* request) - backtrace) + (let* ((*request* request)) (multiple-value-bind (body error) (catch 'handler-done (handler-bind ((error (lambda (cond) - ;; only generate backtrace if needed - (setq backtrace - (and (or (and *show-lisp-errors-p* - *show-lisp-backtraces-p*) - (and *log-lisp-errors-p* - *log-lisp-backtraces-p*)) - (get-backtrace cond))) (when *log-lisp-errors-p* - (log-message* *lisp-errors-log-level* - "~A~:[~*~;~%~A~]" - cond - *log-lisp-backtraces-p* - backtrace)) + (log-message* *lisp-errors-log-level* "~A" cond)) ;; if the headers were already sent ;; the error happens within the body ;; and we have to close the stream @@ -528,11 +516,7 @@ (warning (lambda (cond) (when *log-lisp-warnings-p* - (log-message* *lisp-warnings-log-level* - "~A~:[~*~;~%~A~]" - cond - *log-lisp-backtraces-p* - backtrace))))) + (log-message* *lisp-warnings-log-level* "~A" cond))))) ;; skip dispatch if bad request (when (eql (return-code) +http-ok+) ;; now do the work @@ -540,12 +524,7 @@ (when error (setf (return-code *reply*) +http-internal-server-error+)) - (start-output :content (cond ((and error *show-lisp-errors-p*) - (format nil "
      ~A~:[~*~;~%~%~A~]
      " - (escape-for-html (format nil "~A" error)) - *show-lisp-backtraces-p* - (escape-for-html (format nil "~A" backtrace)))) - (error + (start-output :content (cond (error "An error has occured.") (t body)))) t) Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:32:09 UTC (rev 4221) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:45:45 UTC (rev 4222) @@ -198,22 +198,12 @@ (defvar *show-lisp-errors-p* nil "Whether Lisp errors should be shown in HTML output.") -(defvar *show-lisp-backtraces-p* nil - "Whether Lisp backtraces should be shown in HTML output when an -error occurs. Will only have an effect if *SHOW-LISP-ERRORS-P* is -also true.") - (defvar *log-lisp-errors-p* t "Whether Lisp errors should be logged.") (defvar *log-lisp-warnings-p* t "Whether Lisp warnings should be logged.") -(defvar *log-lisp-backtraces-p* nil - "Whether Lisp backtraces should be logged when an error or warning -occurs. Will only have an effect if *LOG-LISP-ERRORS-P* or -*LOG-LISP-BACKTRACES* are also true.") - (defvar *lisp-errors-log-level* :error "Log level for Lisp errors.") From bknr at bknr.net Tue Feb 10 10:49:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:49:33 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/test/test.lisp Message-ID: Revision: 4223 Author: edi URL: http://bknr.net/trac/changeset/4223 Remove in test as well U trunk/thirdparty/hunchentoot/test/test.lisp Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 10:45:45 UTC (rev 4222) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 10:49:33 UTC (rev 4223) @@ -513,14 +513,10 @@ "Forbidden \(403) page"))) (:tr (:td (:a :href "/hunchentoot/test/oops.html" "Error handling") - " \(output depends on settings like " + " \(output depends on " (:a :href "http://weitz.de/hunchentoot/#*show-lisp-errors-p*" (:code "*SHOW-LISP-ERRORS-P*")) - (fmt " \(currently ~S) and " *show-lisp-errors-p*) - (:a :href "http://weitz.de/hunchentoot/#*show-lisp-backtraces-p*" - (:code "*SHOW-LISP-BACKTRACES-P*")) - (fmt " \(currently ~S)" *show-lisp-backtraces-p*) - ")")) + (fmt " \(currently ~S))" *show-lisp-errors-p*))) (:tr (:td (:a :href "/hunchentoot/foo" "URI handled by") " " From bknr at bknr.net Tue Feb 10 10:56:55 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:56:55 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4224 Author: edi URL: http://bknr.net/trac/changeset/4224 Checkpoint, not in a working state U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd U trunk/thirdparty/hunchentoot/server.lisp U trunk/thirdparty/hunchentoot/specials.lisp Change set too large, please see URL above From bknr at bknr.net Tue Feb 10 10:57:06 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 11:57:06 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4225 Author: edi URL: http://bknr.net/trac/changeset/4225 Rename file A trunk/thirdparty/hunchentoot/acceptor.lisp D trunk/thirdparty/hunchentoot/server.lisp Change set too large, please see URL above From bknr at bknr.net Tue Feb 10 11:29:08 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 12:29:08 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4226 Author: edi URL: http://bknr.net/trac/changeset/4226 More lunacy U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/lispworks.lisp U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/ssl.lisp U trunk/thirdparty/hunchentoot/test/test.lisp U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -309,7 +309,7 @@ (parameter-error "Hunchentoot SSL support is not compiled in.")) (let ((server (apply #'make-instance #-:hunchentoot-no-ssl - (if ssl-certificate-file 'ssl-server 'server) + (if ssl-certificate-file 'ssl-acceptor 'acceptor) #+:hunchentoot-no-ssl 'server args))) @@ -331,25 +331,25 @@ (:method ((acceptor acceptor)) #+:lispworks (multiple-value-bind (listener-process startup-condition) - (comm:start-up-acceptor :service (acceptor-port acceptor) - :address (acceptor-address acceptor) - :process-name (format nil "Hunchentoot listener \(~A:~A)" - (or (acceptor-address acceptor) "*") (acceptor-port acceptor)) - ;; this function is called once on startup - we - ;; use it to check for errors - :announce (lambda (socket &optional condition) - (declare (ignore socket)) - (when condition - (error condition))) - ;; this function is called whenever a connection - ;; is made - :function (lambda (handle) - (unless (acceptor-shutdown-p acceptor) - (handle-incoming-connection - (acceptor-connection-dispatcher acceptor) handle))) - ;; wait until the acceptor was successfully started - ;; or an error condition is returned - :wait t) + (comm:start-up-server :service (acceptor-port acceptor) + :address (acceptor-address acceptor) + :process-name (format nil "Hunchentoot listener \(~A:~A)" + (or (acceptor-address acceptor) "*") (acceptor-port acceptor)) + ;; this function is called once on startup - we + ;; use it to check for errors + :announce (lambda (socket &optional condition) + (declare (ignore socket)) + (when condition + (error condition))) + ;; this function is called whenever a connection + ;; is made + :function (lambda (handle) + (unless (acceptor-shutdown-p acceptor) + (handle-incoming-connection + (acceptor-connection-dispatcher acceptor) handle))) + ;; wait until the acceptor was successfully started + ;; or an error condition is returned + :wait t) (when startup-condition (error startup-condition)) (mp:process-stop listener-process) @@ -479,7 +479,7 @@ :content-stream *hunchentoot-stream* :method method :uri url-string - :acceptor-protocol acceptor-protocol)))) + :server-protocol acceptor-protocol)))) (force-output *hunchentoot-stream*) (setq *hunchentoot-stream* (reset-connection-stream *acceptor* *hunchentoot-stream*)) (when *close-hunchentoot-stream* @@ -523,7 +523,7 @@ (dispatch-request *acceptor* *request* *reply*)))) (when error (setf (return-code *reply*) - +http-internal-acceptor-error+)) + +http-internal-server-error+)) (start-output :content (cond (error "An error has occured.") (t body)))) Modified: trunk/thirdparty/hunchentoot/easy-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -312,7 +312,7 @@ defined with DEFINE-EASY-HANDLER, if there is one." (loop for (uri server-names easy-handler) in *easy-handler-alist* when (and (or (eq server-names t) - (find (server-name *server*) server-names :test #'eq)) + (find (acceptor-name *acceptor*) server-names :test #'eq)) (cond ((stringp uri) (string= (script-name request) uri)) (t (funcall uri request)))) Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -84,7 +84,7 @@ ;; Read post data to clear stream - Force binary mode to avoid OCTETS-TO-STRING overhead. (raw-post-data :force-binary t) (let* ((return-code (return-code)) - (chunkedp (and (server-output-chunking-p *server*) + (chunkedp (and (acceptor-output-chunking-p *acceptor*) (eq (server-protocol request) :http/1.1) ;; only turn chunking on if the content ;; length is unknown at this point... @@ -114,7 +114,7 @@ (setf (header-out :transfer-encoding) "chunked")) (cond (keep-alive-p (setf *close-hunchentoot-stream* nil) - (when (and (server-read-timeout *server*) + (when (and (acceptor-read-timeout *acceptor*) (or (not (eq (server-protocol request) :http/1.1)) keep-alive-requested-p)) ;; persistent connections are implicitly assumed for @@ -122,7 +122,7 @@ ;; client has explicitly asked for one (setf (header-out :connection) "Keep-Alive" (header-out :keep-alive) - (format nil "timeout=~D" (server-read-timeout *server*))))) + (format nil "timeout=~D" (acceptor-read-timeout *acceptor*))))) (t (setf (header-out :connection) "Close")))) (unless (and (header-out-set-p :server) (null (header-out :server))) @@ -204,7 +204,7 @@ (write-sequence +crlf+ *hunchentoot-stream*) (maybe-write-to-header-stream "") ;; access log message - (when-let (access-logger (server-access-logger *server*)) + (when-let (access-logger (acceptor-access-logger *acceptor*)) (funcall access-logger :return-code return-code :content content Modified: trunk/thirdparty/hunchentoot/lispworks.lisp =================================================================== --- trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -79,18 +79,18 @@ (comm:get-socket-peer-address socket) (values (ignore-errors (comm:ip-address-string peer-addr)) peer-port))) -(defun make-socket-stream (socket server) - "Returns a stream for the socket SOCKET. The SERVER argument is +(defun make-socket-stream (socket acceptor) + "Returns a stream for the socket SOCKET. The ACCEPTOR argument is used to set the timeouts." #-:lispworks5 - (when (server-write-timeout server) + (when (acceptor-write-timeout acceptor) (parameter-error "You need LispWorks 5 or higher for write timeouts.")) (make-instance 'comm:socket-stream :socket socket :direction :io - :read-timeout (server-read-timeout server) + :read-timeout (acceptor-read-timeout acceptor) #+:lispworks5 #+:lispworks5 - :write-timeout (server-write-timeout server) + :write-timeout (acceptor-write-timeout acceptor) :element-type 'octet)) (defun make-lock (name) Modified: trunk/thirdparty/hunchentoot/log.lisp =================================================================== --- trunk/thirdparty/hunchentoot/log.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -114,7 +114,7 @@ (defun log-message* (log-level format &rest args) "Internal function accepting the same arguments as LOG-MESSAGE and using the message logger of *SERVER* \(if there is one)." - (when-let (message-logger (server-message-logger *server*)) + (when-let (message-logger (acceptor-message-logger *acceptor*)) (apply message-logger log-level format args))) (define-log-file access-log-file *access-log-file* *access-log-pathname* Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -62,7 +62,7 @@ "*REPLY*" "*REQUEST*" "*REWRITE-FOR-SESSION-URLS*" - "*SERVER*" + "*ACCEPTOR*" "*SESSION*" "*SESSION-COOKIE-NAME*" "*SESSION-GC-FREQUENCY*" @@ -193,10 +193,10 @@ "SCRIPT-NAME" "SCRIPT-NAME*" "SEND-HEADERS" - "SERVER-ADDRESS" - "SERVER-DISPATCH-TABLE" - "SERVER-NAME" - "SERVER-PORT" + "ACCEPTOR-ADDRESS" + "ACCEPTOR-DISPATCH-TABLE" + "ACCEPTOR-NAME" + "ACCEPTOR-PORT" "SERVER-PROTOCOL" "SERVER-PROTOCOL*" "SESSION-COOKIE-VALUE" Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -289,10 +289,6 @@ "During the execution of dispatchers and handlers this variable is bound to the SERVER object which processes the request.") -(defvar *acceptor-counter* 0 - "Internal counter used to generate meaningful names for -listener threads.") - (defvar *worker-counter* 0 "Internal counter used to generate meaningful names for worker threads.") Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -29,30 +29,30 @@ (in-package :hunchentoot) -(defclass ssl-server (server) +(defclass ssl-acceptor (acceptor) ((ssl-certificate-file :initarg :ssl-certificate-file - :reader server-ssl-certificate-file + :reader acceptor-ssl-certificate-file :documentation "The namestring of a certificate file.") (ssl-privatekey-file :initarg :ssl-privatekey-file - :reader server-ssl-privatekey-file + :reader acceptor-ssl-privatekey-file :documentation "The namestring of a private key file, or NIL if the certificate file contains the private key.") (ssl-privatekey-password #+:lispworks #+:lispworks :initform nil :initarg :ssl-privatekey-password - :reader server-ssl-privatekey-password + :reader acceptor-ssl-privatekey-password :documentation "The password for the private key file or NIL.")) (:default-initargs :port 443 :output-chunking-p nil) (:documentation "This class defines additional slots required to serve requests by SSL")) -(defmethod initialize-instance :around ((server ssl-server) +(defmethod initialize-instance :around ((acceptor ssl-acceptor) &rest args &key ssl-certificate-file ssl-privatekey-file &allow-other-keys) - (apply #'call-next-method server + (apply #'call-next-method acceptor :ssl-certificate-file (namestring ssl-certificate-file) :ssl-privatekey-file (namestring (or ssl-privatekey-file #+:lispworks @@ -60,8 +60,8 @@ args)) #+lispworks -(defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) - "Given the server socket stream SOCKET-STREAM attaches SSL to the +(defun make-ssl-acceptor-stream (socket-stream &key certificate-file privatekey-file privatekey-password) + "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the stream using the certificate file CERTIFICATE-FILE and the private key file PRIVATEKEY-FILE. Both of these values must be namestrings denoting the location of the files. If PRIVATEKEY-PASSWORD is not NIL @@ -81,18 +81,18 @@ socket-stream)) -(defmethod server-ssl-p ((server ssl-server)) +(defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) t) -(defmethod initialize-connection-stream ((server ssl-server) stream) +(defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream) ;; attach SSL to the stream if necessary - (call-next-method server + (call-next-method acceptor #+:lispworks - (make-ssl-server-stream stream - :certificate-file (server-ssl-certificate-file server) - :privatekey-file (server-ssl-privatekey-file server) - :privatekey-password (server-ssl-privatekey-password server)) + (make-ssl-acceptor-stream stream + :certificate-file (acceptor-ssl-certificate-file acceptor) + :privatekey-file (acceptor-ssl-privatekey-file acceptor) + :privatekey-password (acceptor-ssl-privatekey-password acceptor)) #-:lispworks - (cl+ssl:make-ssl-server-stream stream - :certificate (server-ssl-certificate-file server) - :key (server-ssl-privatekey-file server)))) \ No newline at end of file + (cl+ssl:make-ssl-acceptor-stream stream + :certificate (acceptor-ssl-certificate-file acceptor) + :key (acceptor-ssl-privatekey-file acceptor)))) \ No newline at end of file Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -118,8 +118,8 @@ (fmt "~[~;once~;twice~:;~:*~R times~]" (incf count))) " since its handler was compiled.") (info-table (host) - (server-address *server*) - (server-port) + (acceptor-address *acceptor*) + (acceptor-port) (remote-addr*) (remote-port*) (real-remote-addr) Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -357,7 +357,7 @@ values of the `Connection' header." (member value connection-values :test #'string-equal))) (let ((keep-alive-requested-p (connection-value-p "keep-alive"))) - (values (and (server-persistent-connections-p *server*) + (values (and (acceptor-persistent-connections-p *acceptor*) (or (and (eq (server-protocol request) :http/1.1) (not (connection-value-p "close"))) (and (eq (server-protocol request) :http/1.0) @@ -372,9 +372,9 @@ +implementation-link+ (escape-for-html (lisp-implementation-type)) (escape-for-html (lisp-implementation-version)) - (or (host *request*) (server-address *server*)) + (or (host *request*) (acceptor-address *acceptor*)) (scan ":\\d+$" (or (host *request*) "")) - (server-port))) + (acceptor-port))) (defun server-name-header () "Returns a string which can be used for 'Server' headers." From bknr at bknr.net Tue Feb 10 11:48:20 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 12:48:20 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4227 Author: edi URL: http://bknr.net/trac/changeset/4227 More U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/test/test.lisp U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -31,9 +31,11 @@ (defclass acceptor () ((port :initarg :port + :reader acceptor-port :documentation "The port the acceptor is listening on. See START-SERVER.") (address :initarg :address + :reader acceptor-address :documentation "The address the acceptor is listening on. See START-SERVER.") (name :initarg :name @@ -183,14 +185,6 @@ (format stream "\(host ~A, port ~A)" (or (acceptor-address acceptor) "*") (acceptor-port acceptor)))) -(defun acceptor-address (&optional (acceptor *acceptor*)) - "Returns the address at which the current request arrived." - (slot-value acceptor 'address)) - -(defun acceptor-port (&optional (acceptor *acceptor*)) - "Returns the port at which the current request arrived." - (slot-value acceptor 'port)) - (defgeneric start (acceptor) (:documentation "Start the ACCEPTOR so that it begins accepting connections.") Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -29,13 +29,10 @@ (in-package :hunchentoot) -;;; The connection-dispatcher protocol defines how Hunchentoot schedules -;;; request execution to worker threads or for inline execution. - (defclass connection-dispatcher () ((acceptor :initarg :acceptor - :reader acceptor - :documentation "The Hunchentoot acceptor instance that this + :reader acceptor + :documentation "The acceptor instance that this connection dispatcher works for.")) (:documentation "Base class for all connection dispatchers classes. Its purpose is to carry the back pointer to the acceptor instance.")) @@ -69,9 +66,9 @@ (defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated with the connection dispatcher, if any.") - (:method ((manager t)) + (:method ((dispatcher t)) #+:lispworks - (when-let (acceptor (acceptor-acceptor (acceptor manager))) + (when-let (acceptor (acceptor-acceptor (acceptor dispatcher))) ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER (mp:process-kill acceptor)))) @@ -81,11 +78,11 @@ (:documentation "Connection Dispatcher that runs synchronously in the thread that invoked the START-SERVER function.")) -(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) - (accept-connections (acceptor manager))) +(defmethod execute-acceptor ((dispatcher single-threaded-connection-dispatcher)) + (accept-connections (acceptor dispatcher))) -(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) - (process-connection (acceptor manager) socket)) +(defmethod handle-incoming-connection ((dispatcher single-threaded-connection-dispatcher) socket) + (process-connection (acceptor dispatcher) socket)) (defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process @@ -96,25 +93,25 @@ listening to incoming requests and one thread for each incoming connection.")) -(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) +(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) #+:lispworks - (accept-connections (acceptor manager)) + (accept-connections (acceptor dispatcher)) #-:lispworks - (setf (acceptor-process manager) + (setf (acceptor-process dispatcher) (bt:make-thread (lambda () - (accept-connections (acceptor manager))) + (accept-connections (acceptor dispatcher))) :name (format nil "Hunchentoot acceptor \(~A:~A)" - (or (acceptor-address (acceptor manager)) "*") - (acceptor-port (acceptor manager)))))) + (or (acceptor-address (acceptor dispatcher)) "*") + (acceptor-port (acceptor dispatcher)))))) #-:lispworks -(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) +(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) (loop - while (bt:thread-alive-p (acceptor-process manager)) + while (bt:thread-alive-p (acceptor-process dispatcher)) do (sleep 1))) #+:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* @@ -125,7 +122,7 @@ (multiple-value-list (get-peer-address-and-port handle))) nil #'process-connection - (acceptor manager) handle)) + (acceptor dispatcher) handle)) #-:lispworks (defun client-as-string (socket) @@ -137,7 +134,7 @@ port)))) #-:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) (bt:make-thread (lambda () - (process-connection (acceptor manager) socket)) + (process-connection (acceptor dispatcher) socket)) :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -119,7 +119,7 @@ " since its handler was compiled.") (info-table (host) (acceptor-address *acceptor*) - (acceptor-port) + (acceptor-port *acceptor*) (remote-addr*) (remote-port*) (real-remote-addr) Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -374,7 +374,7 @@ (escape-for-html (lisp-implementation-version)) (or (host *request*) (acceptor-address *acceptor*)) (scan ":\\d+$" (or (host *request*) "")) - (acceptor-port))) + (acceptor-port *acceptor*))) (defun server-name-header () "Returns a string which can be used for 'Server' headers." From bknr at bknr.net Tue Feb 10 13:46:48 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 14:46:48 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/chunga/ Message-ID: Revision: 4228 Author: hans URL: http://bknr.net/trac/changeset/4228 Unexport SKIP-WHITESPACE and TRIM-WHITESPACE U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 11:48:19 UTC (rev 4227) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 13:46:48 UTC (rev 4228) @@ -89,9 +89,7 @@
    • read-name-value-pair
    • read-name-value-pairs
    • assert-char -
    • skip-whitespace
    • read-char* -
    • trim-whitespace
    • *current-error-message*
    • *accept-bogus-eols*
    • *treat-semicolon-as-continuation* @@ -607,25 +605,6 @@ - - -


      [Function]
      skip-whitespace stream => char-or-nil -


      - -Consume characters from the binary stream stream until an END-OF-FILE is -encountered or a non-whitespace (according to RFC 2616) -characters is seen. This character is returned (or NIL in case -of END-OF-FILE). -

      -See WITH-CHARACTER-STREAM-SEMANTICS. - -

      - - - -


      [Function]
      read-char* stream => char @@ -640,19 +619,6 @@ - - -


      [Function]
      trim-whitespace string => string' -


      - -Returns a version of the string string where spaces and tab -characters are trimmed from the start and the end. - -
      - - - -


      [Special variable]
      *current-error-message* Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 11:48:19 UTC (rev 4227) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 13:46:48 UTC (rev 4228) @@ -59,8 +59,6 @@ :read-name-value-pair :read-name-value-pairs :read-token - :skip-whitespace :syntax-error - :trim-whitespace :with-character-stream-semantics)) From bknr at bknr.net Tue Feb 10 14:25:30 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 15:25:30 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/chunga/ Message-ID: Revision: 4229 Author: hans URL: http://bknr.net/trac/changeset/4229 revert 4228 U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 13:46:48 UTC (rev 4228) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:25:30 UTC (rev 4229) @@ -89,7 +89,9 @@

    • read-name-value-pair
    • read-name-value-pairs
    • assert-char +
    • skip-whitespace
    • read-char* +
    • trim-whitespace
    • *current-error-message*
    • *accept-bogus-eols*
    • *treat-semicolon-as-continuation* @@ -605,6 +607,25 @@ + + +


      [Function]
      skip-whitespace stream => char-or-nil +


      + +Consume characters from the binary stream stream until an END-OF-FILE is +encountered or a non-whitespace (according to RFC 2616) +characters is seen. This character is returned (or NIL in case +of END-OF-FILE). +

      +See WITH-CHARACTER-STREAM-SEMANTICS. + +

      + + + +


      [Function]
      read-char* stream => char @@ -619,6 +640,19 @@ + + +


      [Function]
      trim-whitespace string => string' +


      + +Returns a version of the string string where spaces and tab +characters are trimmed from the start and the end. + +
      + + + +


      [Special variable]
      *current-error-message* Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 13:46:48 UTC (rev 4228) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:25:30 UTC (rev 4229) @@ -59,6 +59,8 @@ :read-name-value-pair :read-name-value-pairs :read-token + :skip-whitespace :syntax-error + :trim-whitespace :with-character-stream-semantics)) From bknr at bknr.net Tue Feb 10 14:46:11 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 15:46:11 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4230 Author: edi URL: http://bknr.net/trac/changeset/4230 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/packages.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -32,12 +32,10 @@ (defclass acceptor () ((port :initarg :port :reader acceptor-port - :documentation "The port the acceptor is listening on. -See START-SERVER.") + :documentation "The port the acceptor is listening on.") (address :initarg :address :reader acceptor-address - :documentation "The address the acceptor is listening -on. See START-SERVER.") + :documentation "The address the acceptor is listening on.") (name :initarg :name :accessor acceptor-name :documentation "The optional name of the acceptor, a symbol.") @@ -46,10 +44,10 @@ :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol naming) a class which inherits from REQUEST.") - (dispatch-table :initarg :dispatch-table - :accessor acceptor-dispatch-table - :documentation "The dispatch-table used by this -acceptor. Can be NIL to denote that *DISPATCH-TABLE* should be used.") + (request-dispatcher :initarg :request-dispatcher + :accessor acceptor-request-dispatcher + :documentation "The dispatcher function used by +this acceptor.") (output-chunking-p :initarg :output-chunking-p :reader acceptor-output-chunking-p :documentation "Whether the acceptor may use output chunking.") @@ -71,28 +69,28 @@ semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts.") (write-timeout :initarg :write-timeout - :reader acceptor-write-timeout - :documentation "The connection timeout of the acceptor, + :reader acceptor-write-timeout + :documentation "The connection timeout of the acceptor, specified in (fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts.") (connection-dispatcher :initarg :connection-dispatcher - :initform nil - :reader acceptor-connection-dispatcher - :documentation "The connection dispatcher that is + :initform nil + :reader acceptor-connection-dispatcher + :documentation "The connection dispatcher that is responsible for listening to new connections and scheduling them for execution.") #+:lispworks - (acceptor :accessor acceptor-acceptor - :documentation "The Lisp process which accepts incoming + (process :accessor acceptor-process + :documentation "The Lisp process which accepts incoming requests.") #-:lispworks (listen-socket :accessor acceptor-listen-socket :documentation "The listen socket for incoming connections.") (acceptor-shutdown-p :initform nil - :accessor acceptor-shutdown-p - :documentation "Flag that makes the acceptor + :accessor acceptor-shutdown-p + :documentation "Flag that makes the acceptor shutdown itself when set to something other than NIL.") (access-logger :initarg :access-logger :accessor acceptor-access-logger @@ -120,66 +118,12 @@ :request-class 'request :output-chunking-p t :input-chunking-p t - :dispatch-table nil + :request-dispatcher 'dispatch-request :access-logger 'log-access :message-logger 'log-message) (:documentation "An object of this class contains all relevant information about a running Hunchentoot acceptor instance.")) -(defmethod initialize-instance :after ((acceptor acceptor) - &key connection-dispatcher-class - connection-dispatcher-arguments - (threaded *supports-threads-p* threaded-specified-p) - (persistent-connections-p - threaded - persistent-connections-specified-p) - (connection-timeout - *default-connection-timeout* - connection-timeout-provided-p) - (read-timeout nil read-timeout-provided-p) - (write-timeout nil write-timeout-provided-p)) - "The CONNECTION-DISPATCHER-CLASS and CONNECTION-DISPATCHER-ARGUMENTS -arguments to the creation of a acceptor instance determine the -connection dispatcher instance that is created. THREADED is the user -friendly version of the CONNECTION-DISPATCHER-CLASS option. If it is -NIL, an unthreaded connection dispatcher is used. It is an error to -specify both THREADED and a CONNECTION-DISPATCHER-CLASS argument. - -The PERSISTENT-CONNECTIONS-P keyword argument defaults to the value of -the THREADED keyword argument but can be overridden. - -If a neither READ-TIMEOUT nor WRITE-TIMEOUT are specified by the user, -the acceptor's read and write timeouts default to the CONNECTION-TIMEOUT -value. If either of READ-TIMEOUT or WRITE-TIMEOUT is specified, -CONNECTION-TIMEOUT is not used and may not be supplied." - (declare (ignore read-timeout write-timeout)) - (when (and threaded-specified-p connection-dispatcher-class) - (parameter-error "Can't use both THREADED and CONNECTION-DISPATCHER-CLASS arguments.")) - (unless persistent-connections-specified-p - (setf (acceptor-persistent-connections-p acceptor) persistent-connections-p)) - (unless (acceptor-connection-dispatcher acceptor) - (setf (slot-value acceptor 'connection-dispatcher) - (apply #'make-instance - (or connection-dispatcher-class - (if threaded - 'one-thread-per-connection-dispatcher - 'single-threaded-connection-dispatcher)) - :acceptor acceptor - connection-dispatcher-arguments))) - (if (or read-timeout-provided-p write-timeout-provided-p) - (when connection-timeout-provided-p - (parameter-error "Can't have both CONNECTION-TIMEOUT and either of READ-TIMEOUT and WRITE-TIMEOUT.")) - (setf (slot-value acceptor 'read-timeout) connection-timeout - (slot-value acceptor 'write-timeout) connection-timeout))) - -(defgeneric acceptor-ssl-p (acceptor) - (:documentation "Returns a true value if ACCEPTOR is an SSL acceptor.") - (:method ((acceptor t)) - nil)) - -(defun ssl-p (&optional (acceptor *acceptor*)) - (acceptor-ssl-p acceptor)) - (defmethod print-object ((acceptor acceptor) stream) (print-unreadable-object (acceptor stream :type t) (format stream "\(host ~A, port ~A)" @@ -347,7 +291,7 @@ (when startup-condition (error startup-condition)) (mp:process-stop listener-process) - (setf (acceptor-acceptor acceptor) listener-process)) + (setf (acceptor-process acceptor) listener-process)) #-:lispworks (setf (acceptor-listen-socket acceptor) (usocket:socket-listen (or (acceptor-address acceptor) @@ -362,7 +306,7 @@ using HANDLE-INCOMING-CONNECTION.") (:method ((acceptor acceptor)) #+:lispworks - (mp:process-unstop (acceptor-acceptor acceptor)) + (mp:process-unstop (acceptor-process acceptor)) #-:lispworks (usocket:with-acceptor-socket (listener (acceptor-listen-socket acceptor)) (loop @@ -405,6 +349,7 @@ (chunked-stream-stream stream)) (t stream)))) +;;; TODO (defgeneric dispatch-request (acceptor request reply) (:documentation "") (:method (acceptor request reply) Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -65,13 +65,7 @@ (defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated -with the connection dispatcher, if any.") - (:method ((dispatcher t)) - #+:lispworks - (when-let (acceptor (acceptor-acceptor (acceptor dispatcher))) - ;; kill the main acceptor process, see LW documentation for - ;; COMM:START-UP-SERVER - (mp:process-kill acceptor)))) +with the connection dispatcher, if any.")) (defclass single-threaded-connection-dispatcher (connection-dispatcher) () @@ -87,16 +81,27 @@ (defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process :documentation "Process that accepts incoming - connections and dispatches them to new processes - for request execution.")) +connections and dispatches them to new processes for request +execution.")) (:documentation "Connection Dispatcher that starts one thread for listening to incoming requests and one thread for each incoming connection.")) +;; usocket implementation + +#-:lispworks +(defmethod shutdown ((dispatcher connection-dispatcher))) + +#-:lispworks +(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) + ;; just wait until the acceptor process has finished, then return + (loop + (unless (bt:thread-alive-p (acceptor-process dispatcher)) + (return)) + (sleep 1))) + +#-:lispworks (defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) - #+:lispworks - (accept-connections (acceptor dispatcher)) - #-:lispworks (setf (acceptor-process dispatcher) (bt:make-thread (lambda () (accept-connections (acceptor dispatcher))) @@ -105,12 +110,34 @@ (acceptor-port (acceptor dispatcher)))))) #-:lispworks -(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) - (loop - while (bt:thread-alive-p (acceptor-process dispatcher)) - do (sleep 1))) +(defun client-as-string (socket) + (let ((address (usocket:get-peer-address socket)) + (port (usocket:get-peer-port socket))) + (when (and address port) + (format nil "~A:~A" + (usocket:vector-quad-to-dotted-quad address) + port)))) +#-:lispworks +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) + (bt:make-thread (lambda () + (process-connection (acceptor dispatcher) socket)) + :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) + +;; LispWorks implementation + #+:lispworks +(defmethod shutdown ((dispatcher connection-dispatcher)) + (when-let (process (acceptor-process (acceptor dispatcher))) + ;; kill the main acceptor process, see LW documentation for + ;; COMM:START-UP-SERVER + (mp:process-kill process))) + +#+:lispworks +(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) + (accept-connections (acceptor dispatcher))) + +#+:lispworks (defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC @@ -123,18 +150,3 @@ (get-peer-address-and-port handle))) nil #'process-connection (acceptor dispatcher) handle)) - -#-:lispworks -(defun client-as-string (socket) - (let ((address (usocket:get-peer-address socket)) - (port (usocket:get-peer-port socket))) - (when (and address port) - (format nil "~A:~A" - (usocket:vector-quad-to-dotted-quad address) - port)))) - -#-:lispworks -(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) - (bt:make-thread (lambda () - (process-connection (acceptor dispatcher) socket)) - :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -143,9 +143,11 @@ "DISPATCH-REQUEST" "DO-SESSIONS" "ESCAPE-FOR-HTML" + "EXECUTE-ACCEPTOR" "GET-PARAMETER" "GET-PARAMETERS" "GET-PARAMETERS*" + "HANDLE-INCOMING-CONNECTION" "HANDLE-IF-MODIFIED-SINCE" "HANDLE-STATIC-FILE" "HANDLER-DONE" @@ -194,7 +196,7 @@ "SCRIPT-NAME*" "SEND-HEADERS" "ACCEPTOR-ADDRESS" - "ACCEPTOR-DISPATCH-TABLE" + "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-NAME" "ACCEPTOR-PORT" "SERVER-PROTOCOL" @@ -209,10 +211,10 @@ "SESSION-VALUE" "SET-COOKIE" "SET-COOKIE*" - "SSL-P" - "START-SERVER" + "SHUTDOWN" + "START" "START-SESSION" - "STOP-SERVER" + "STOP" "URL-DECODE" "URL-ENCODE" "USER-AGENT")) From bknr at bknr.net Tue Feb 10 14:50:32 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 15:50:32 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/ Message-ID: Revision: 4231 Author: hans URL: http://bknr.net/trac/changeset/4231 Fix cookie parsing. U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/util.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:50:32 UTC (rev 4231) @@ -91,6 +91,7 @@

    • assert-char
    • skip-whitespace
    • read-char* +
    • peek-char*
    • trim-whitespace
    • *current-error-message*
    • *accept-bogus-eols* @@ -640,6 +641,25 @@ + + +


      [Function]
      peek-char* stream &optional eof-error-p eof-value => boolean +


      + +Returns a true value if a character can be read from the binary +stream stream. If eof-error-p +has a true value, an error is signalled if no character remains to be +read. eof-value specifies the value to return +if eof-error-p is false and the end of the file +has been reached. +

      +See WITH-CHARACTER-STREAM-SEMANTICS. + +

      + + + +


      [Function]
      trim-whitespace string => string' Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -54,6 +54,7 @@ :input-chunking-unexpected-end-of-file :make-chunked-stream :read-http-headers + :peek-char* :read-char* :read-line* :read-name-value-pair Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -249,7 +249,7 @@ of three-element lists where each one contains the name of the cookie, the value of the cookie, and an attribute/value list for the optional cookie parameters." - (with-input-from-string (stream string) + (with-sequence-from-string (stream string) (loop with *current-error-message* = (format nil "While parsing cookie header ~S:" string) for first = t then nil for next = (and (skip-whitespace stream) Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/read.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -60,7 +60,7 @@ HTTP-REQUEST. Returns NIL if there is no such header amongst HEADERS." (when-let (content-type (header-value :content-type headers)) - (with-input-from-sequence (stream (map 'list 'char-code content-type)) + (with-sequence-from-string (stream content-type) (let* ((*current-error-message* "Corrupted Content-Type header:") (type (read-token stream)) (subtype (and (assert-char stream #\/) @@ -80,8 +80,8 @@ "Reads and consumes from STREAM any number of commas and whitespace. Returns the following character or NIL in case of END-OF-FILE." - (loop while (eql (peek-char nil stream nil) #\,) - do (read-char stream) (skip-whitespace stream)) + (loop while (eql (peek-char* stream nil) #\,) + do (read-char* stream) (skip-whitespace stream)) (skip-whitespace stream)) (defun read-tokens-and-parameters (string &key (value-required-p t)) @@ -94,7 +94,7 @@ \(the attribute/value pairs). If VALUE-REQUIRED-P is NIL, the value part \(including the #\\= character) of each attribute/value pair is optional." - (with-input-from-string (stream string) + (with-sequence-from-string (stream string) (loop with *current-error-message* = (format nil "While parsing ~S:" string) for first = t then nil for next = (and (skip-whitespace stream) Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/util.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -274,3 +274,9 @@ (or (null candidate-subtype) (string-equal subtype candidate-subtype))))) +(defmacro with-sequence-from-string ((stream string) &body body) + "Kludge to make Chunga tokenizing functionality usable. Works like + WITH-INPUT-FROM-STRING, but creates a sequence of octets that works + with CHUNGA::PEEK-CHAR* and friends." + `(flex:with-input-from-sequence (,stream (map 'list #'char-code ,string)) + , at body)) \ No newline at end of file From bknr at bknr.net Tue Feb 10 16:21:06 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 17:21:06 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/drakma/request.lisp Message-ID: Revision: 4232 Author: hans URL: http://bknr.net/trac/changeset/4232 die sprachpolizei, tatue! U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-10 14:50:32 UTC (rev 4231) +++ trunk/thirdparty/drakma/request.lisp 2009-02-10 16:21:06 UTC (rev 4232) @@ -245,11 +245,11 @@ PARAMETERS alist can also be pathnames, open binary input streams, unary functions, or lists where the first element is of one of the former types. These values denote files which should be sent as part -of the request body, i.e. if files are present in PARAMETERS, the -content type of the request is always `multipart/form-data'. If the -value is a list, the part of the list behind the first element is -treated as a plist which can be used to specify a content type and/or -a filename for the file, i.e. such a value could look like, e.g., +of the request body. If files are present in PARAMETERS, the content +type of the request is always `multipart/form-data'. If the value is +a list, the part of the list behind the first element is treated as a +plist which can be used to specify a content type and/or a filename +for the file, i.e. such a value could look like, e.g., \(#p\"/tmp/my_file.doc\" :content-type \"application/msword\" :filename \"upload.doc\"). From bknr at bknr.net Tue Feb 10 16:22:10 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 17:22:10 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/drakma/doc/index.html Message-ID: Revision: 4233 Author: hans URL: http://bknr.net/trac/changeset/4233 die sprachpolizei, tatue! U trunk/thirdparty/drakma/doc/index.html Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-10 16:21:06 UTC (rev 4232) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-10 16:22:10 UTC (rev 4233) @@ -805,7 +805,7 @@ the parameters alist can also be pathnames, unary functions, open binary input streams, or lists where the first element is of one of the former types. These values denote files which should -be sent as part of the request body, i.e. if such file designators are +be sent as part of the request body. If such file designators are present in parameters, the content type of the request is always multipart/form-data. If the value denoting a file is a list, the part of the list behind the first From bknr at bknr.net Tue Feb 10 16:32:11 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 17:32:11 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4234 Author: hans URL: http://bknr.net/trac/changeset/4234 Implement automatic test suite. U trunk/thirdparty/hunchentoot/hunchentoot-test.asd A trunk/thirdparty/hunchentoot/test/script-engine.lisp A trunk/thirdparty/hunchentoot/test/script.lisp A trunk/thirdparty/hunchentoot/test/test-handlers.lisp D trunk/thirdparty/hunchentoot/test/test.lisp Change set too large, please see URL above From bknr at bknr.net Tue Feb 10 16:36:07 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 17:36:07 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4235 Author: edi URL: http://bknr.net/trac/changeset/4235 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/util.lisp Change set too large, please see URL above From bknr at bknr.net Tue Feb 10 16:37:27 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 17:37:27 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ssl.lisp Message-ID: Revision: 4236 Author: edi URL: http://bknr.net/trac/changeset/4236 More name fixes U trunk/thirdparty/hunchentoot/ssl.lisp Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 16:36:06 UTC (rev 4235) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 16:37:27 UTC (rev 4236) @@ -60,7 +60,7 @@ args)) #+lispworks -(defun make-ssl-acceptor-stream (socket-stream &key certificate-file privatekey-file privatekey-password) +(defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the stream using the certificate file CERTIFICATE-FILE and the private key file PRIVATEKEY-FILE. Both of these values must be namestrings @@ -88,11 +88,11 @@ ;; attach SSL to the stream if necessary (call-next-method acceptor #+:lispworks - (make-ssl-acceptor-stream stream + (make-ssl-server-stream stream :certificate-file (acceptor-ssl-certificate-file acceptor) :privatekey-file (acceptor-ssl-privatekey-file acceptor) :privatekey-password (acceptor-ssl-privatekey-password acceptor)) #-:lispworks - (cl+ssl:make-ssl-acceptor-stream stream + (cl+ssl:make-ssl-server-stream stream :certificate (acceptor-ssl-certificate-file acceptor) :key (acceptor-ssl-privatekey-file acceptor)))) \ No newline at end of file From bknr at bknr.net Tue Feb 10 17:35:22 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 18:35:22 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/test/script.lisp Message-ID: Revision: 4237 Author: edi URL: http://bknr.net/trac/changeset/4237 Replace literal characters with portable code U trunk/thirdparty/hunchentoot/test/script.lisp Modified: trunk/thirdparty/hunchentoot/test/script.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-10 16:37:27 UTC (rev 4236) +++ trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-10 17:35:21 UTC (rev 4237) @@ -64,7 +64,7 @@ (format t "Test POST parameters with foreign characters (Latin-1)~%") (http-request "parameter_latin1_post.html" - :method :post :parameters (list (cons "foo" (format nil "H~Chner" #\Latin_Small_Letter_U_With_Diaeresis)))) + :method :post :parameters (list (cons "foo" (format nil "H~Chner" #.(code-char 252))))) (http-assert-header :content-type "text/html; charset=ISO-8859-1") (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") @@ -79,7 +79,7 @@ (http-request "parameter_utf8_post.html" :method :post :external-format-out :utf-8 - :parameters (list (cons "foo" (format nil "H~Chner" #\Latin_Small_Letter_U_With_Diaeresis)))) + :parameters (list (cons "foo" (format nil "H~Chner" #.(code-char 252))))) (http-assert-header :content-type "text/html; charset=UTF-8") (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") From bknr at bknr.net Tue Feb 10 19:56:26 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 10 Feb 2009 20:56:26 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/test/test-handlers.lisp Message-ID: Revision: 4238 Author: edi URL: http://bknr.net/trac/changeset/4238 Re-apply changes that were overwritten U trunk/thirdparty/hunchentoot/test/test-handlers.lisp Modified: trunk/thirdparty/hunchentoot/test/test-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-10 17:35:21 UTC (rev 4237) +++ trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-10 19:56:25 UTC (rev 4238) @@ -118,8 +118,8 @@ (fmt "~[~;once~;twice~:;~:*~R times~]" (incf count))) " since its handler was compiled.") (info-table (host) - (server-address *server*) - (server-port) + (acceptor-address *acceptor*) + (acceptor-port *acceptor*) (remote-addr*) (remote-port*) (real-remote-addr) @@ -513,14 +513,10 @@ "Forbidden \(403) page"))) (:tr (:td (:a :href "/hunchentoot/test/oops.html" "Error handling") - " \(output depends on settings like " + " \(output depends on " (:a :href "http://weitz.de/hunchentoot/#*show-lisp-errors-p*" (:code "*SHOW-LISP-ERRORS-P*")) - (fmt " \(currently ~S) and " *show-lisp-errors-p*) - (:a :href "http://weitz.de/hunchentoot/#*show-lisp-backtraces-p*" - (:code "*SHOW-LISP-BACKTRACES-P*")) - (fmt " \(currently ~S)" *show-lisp-backtraces-p*) - ")")) + (fmt " \(currently ~S))" *show-lisp-errors-p*))) (:tr (:td (:a :href "/hunchentoot/foo" "URI handled by") " " From bknr at bknr.net Wed Feb 11 21:19:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 11 Feb 2009 22:19:33 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4239 Author: edi URL: http://bknr.net/trac/changeset/4239 Some fixes U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/lispworks.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 19:56:25 UTC (rev 4238) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-11 21:19:33 UTC (rev 4239) @@ -40,7 +40,7 @@ :accessor acceptor-name :documentation "The optional name of the acceptor, a symbol.") (request-class :initarg :request-class - :reader acceptor-request-class + :accessor acceptor-request-class :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol naming) a class which inherits from REQUEST.") @@ -54,10 +54,10 @@ responsible for listening to new connections and scheduling them for execution.") (output-chunking-p :initarg :output-chunking-p - :reader acceptor-output-chunking-p + :accessor acceptor-output-chunking-p :documentation "Whether the acceptor may use output chunking.") (input-chunking-p :initarg :input-chunking-p - :reader acceptor-input-chunking-p + :accessor acceptor-input-chunking-p :documentation "Whether the acceptor may use input chunking.") (persistent-connections-p :initarg :persistent-connections-p :accessor acceptor-persistent-connections-p @@ -68,17 +68,17 @@ for non-threaded acceptors.") (read-timeout :initarg :read-timeout :reader acceptor-read-timeout - :documentation "The connection timeout of the acceptor, -specified in (fractional) seconds. Connections that are idle for -longer than this time are closed by Hunchentoot. The precise + :documentation "The connection timeout of the +acceptor, specified in \(fractional) seconds. Connections that are +idle for longer than this time are closed by Hunchentoot. The precise semantics of this parameter is determined by the underlying Lisp's -implementation of socket timeouts.") +implementation of socket timeouts. NIL means no timeout.") (write-timeout :initarg :write-timeout :reader acceptor-write-timeout - :documentation "The connection timeout of the acceptor, -specified in (fractional) seconds. The precise semantics of this -parameter is determined by the underlying Lisp's implementation of -socket timeouts.") + :documentation "The connection timeout of the +acceptor, specified in \(fractional) seconds. The precise semantics +of this parameter is determined by the underlying Lisp's +implementation of socket timeouts. NIL means no timeout.") #+:lispworks (process :accessor acceptor-process :documentation "The Lisp process which accepts incoming @@ -116,9 +116,13 @@ :name (gensym) :request-class 'request :request-dispatcher 'dispatch-request - :connection-dispatcher (make-instance 'one-thread-per-connection-dispatcher) + :connection-dispatcher (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-dispatcher) + (t 'single-threaded-connection-dispatcher))) :output-chunking-p t :input-chunking-p t + :persistent-connections-p t + :read-timeout nil + :write-timeout nil :access-logger 'log-access :message-logger 'log-message) (:documentation "An object of this class contains all relevant @@ -131,7 +135,7 @@ (defgeneric start (acceptor) (:documentation "Starts the ACCEPTOR so that it begins accepting -connections.")) +connections. Returns the acceptor.")) (defgeneric stop (acceptor) (:documentation "Stops the ACCEPTOR so that it no longer accepts @@ -141,7 +145,7 @@ (:documentation "Sets up a listen socket for the given ACCEPTOR and enables it to listen for incoming connections. This function is called from the thread that starts the acceptor initially and may -return errors resulting from the listening operation. (like 'address +return errors resulting from the listening operation \(like 'address in use' or similar).")) (defgeneric accept-connections (acceptor) @@ -182,7 +186,8 @@ (start-listening acceptor) (let ((connection-dispatcher (acceptor-connection-dispatcher acceptor))) (setf (acceptor connection-dispatcher) acceptor) - (execute-acceptor connection-dispatcher))) + (execute-acceptor connection-dispatcher)) + acceptor) (defmethod stop ((acceptor acceptor)) (setf (acceptor-shutdown-p acceptor) t) @@ -191,8 +196,8 @@ (usocket:socket-close (acceptor-listen-socket acceptor))) (defmethod initialize-connection-stream (acceptor stream) + (declare (ignore acceptor)) ;; default method does nothing - (declare (ignore acceptor)) stream) (defmethod reset-connection-stream (acceptor stream) Modified: trunk/thirdparty/hunchentoot/lispworks.lisp =================================================================== --- trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-10 19:56:25 UTC (rev 4238) +++ trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-11 21:19:33 UTC (rev 4239) @@ -62,8 +62,7 @@ "The function which is called if *CLEANUP-INTERVAL* is not NIL.") (defvar *worker-counter* 0 - "Internal counter used to generate meaningful names for worker -threads.") + "Internal counter used to count worker threads.") (defun cleanup-function () "The default for *CLEANUP-FUNCTION*. Invokes a GC on 32-bit Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 19:56:25 UTC (rev 4238) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 21:19:33 UTC (rev 4239) @@ -115,6 +115,19 @@ "+HTTP-USE-PROXY+" "+HTTP-VERSION-NOT-SUPPORTED+" "ACCEPTOR" + "ACCEPTOR-ACCESS-LOGGER" + "ACCEPTOR-ADDRESS" + "ACCEPTOR-INPUT-CHUNKING-P" + "ACCEPTOR-MESSAGE-LOGGER" + "ACCEPTOR-NAME" + "ACCEPTOR-OUTPUT-CHUNKING-P" + "ACCEPTOR-PERSISTENT-CONNECTIONS-P" + "ACCEPTOR-PORT" + "ACCEPTOR-READ-TIMEOUT" + "ACCEPTOR-REQUEST-CLASS" + "ACCEPTOR-REQUEST-DISPATCHER" + "ACCEPTOR-SSL-P" + "ACCEPTOR-WRITE-TIMEOUT" "ACCESS-LOG-FILE" "AUTHORIZATION" "AUX-REQUEST-VALUE" @@ -166,7 +179,6 @@ "INITIALIZE-CONNECTION-STREAM" "LOG-FILE" "LOG-MESSAGE" - "MAYBE-INVOKE-DEBUGGER" "MIME-TYPE" "NO-CACHE" "PARAMETER" @@ -200,11 +212,6 @@ "SCRIPT-NAME" "SCRIPT-NAME*" "SEND-HEADERS" - "ACCEPTOR-ADDRESS" - "ACCEPTOR-REQUEST-DISPATCHER" - "ACCEPTOR-NAME" - "ACCEPTOR-PORT" - "ACCEPTOR-SSL-P" "SERVER-PROTOCOL" "SERVER-PROTOCOL*" "SESSION-COOKIE-VALUE" Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 19:56:25 UTC (rev 4238) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 21:19:33 UTC (rev 4239) @@ -289,10 +289,6 @@ "During the execution of dispatchers and handlers this variable is bound to the SERVER object which processes the request.") -(defvar *worker-counter* 0 - "Internal counter used to generate meaningful names for worker -threads.") - (defvar *default-connection-timeout* 20 "The default connection timeout used when a Hunchentoot server is reading from and writing to a socket stream.") From bknr at bknr.net Wed Feb 11 21:44:43 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 11 Feb 2009 22:44:43 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4240 Author: edi URL: http://bknr.net/trac/changeset/4240 Take care of session secret U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-11 21:19:33 UTC (rev 4239) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-11 21:44:43 UTC (rev 4240) @@ -182,6 +182,11 @@ ;; general implementation +(defmethod start :before ((acceptor acceptor)) + (unless (boundp '*session-secret*) + (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") + (reset-session-secret))) + (defmethod start ((acceptor acceptor)) (start-listening acceptor) (let ((connection-dispatcher (acceptor-connection-dispatcher acceptor))) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 21:19:33 UTC (rev 4239) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 21:44:43 UTC (rev 4240) @@ -38,7 +38,8 @@ (:import-from :hunchentoot-asd :*hunchentoot-version*) #+:lispworks (:import-from :lw "WITH-UNIQUE-NAMES" "WHEN-LET") - (:export "*APPROVED-RETURN-CODES*" + (:export "*ACCEPTOR*" + "*APPROVED-RETURN-CODES*" #+:lispworks "*CLEANUP-FUNCTION*" #+:lispworks @@ -62,12 +63,12 @@ "*REPLY*" "*REQUEST*" "*REWRITE-FOR-SESSION-URLS*" - "*ACCEPTOR*" "*SESSION*" "*SESSION-COOKIE-NAME*" "*SESSION-GC-FREQUENCY*" "*SESSION-MAX-TIME*" "*SESSION-REMOVAL-HOOK*" + "*SESSION-SECRET*" "*SHOW-LISP-ERRORS-P*" "*TMP-DIRECTORY*" "*USE-REMOTE-ADDR-FOR-SESSIONS*" @@ -207,6 +208,7 @@ "REQUIRE-AUTHORIZATION" "RESET-CONNECTION-STREAM" "RESET-SESSIONS" + "RESET-SESSION-SECRET" "RETURN-CODE" "RFC-1123-DATE" "SCRIPT-NAME" Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 21:19:33 UTC (rev 4239) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 21:44:43 UTC (rev 4240) @@ -276,9 +276,13 @@ session-identifier user-agent remote-addr) nil)))))) +(defun reset-session-secret () + "Sets *SESSION-SECRET* to a new random value. All old sessions will +cease to be valid." + (setq *session-secret* (create-random-string 10 36))) + (defun reset-sessions () - "Removes ALL stored sessions and creates a new session secret." - (reset-session-secret) + "Removes ALL stored sessions." (with-lock-held (*session-data-lock*) (loop for (nil . session) in *session-data* do (funcall *session-removal-hook* session)) Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 21:19:33 UTC (rev 4239) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 21:44:43 UTC (rev 4240) @@ -137,7 +137,11 @@ "A fresh random state.") (defvar-unbound *session-secret* - "A random value that's used to encode the public session data.") + "A random ASCII string that's used to encode the public session +data. This variable is initially unbound and will be set \(using +RESET-SESSION-SECRET) by the first acceptor which is started. You can +prevent this from happening if you set the value yourself before +starting acceptors.") (defvar-unbound *hunchentoot-stream* "The stream representing the socket Hunchentoot is listening on.") Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-11 21:19:33 UTC (rev 4239) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-11 21:44:43 UTC (rev 4240) @@ -120,11 +120,6 @@ (format s "~VR" base (random base *the-random-state*))))) -(defun reset-session-secret () - "Sets *SESSION-SECRET* to a new random value. All old sessions will -cease to be valid." - (setq *session-secret* (create-random-string 10 36))) - (defun reason-phrase (return-code) "Returns a reason phrase for the HTTP return code RETURN-CODE \(which should be an integer) or NIL for return codes Hunchentoot From bknr at bknr.net Wed Feb 11 23:10:20 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 00:10:20 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4241 Author: edi URL: http://bknr.net/trac/changeset/4241 Checkpoint session changes U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/test/test-handlers.lisp Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2009-02-11 21:44:43 UTC (rev 4240) +++ trunk/thirdparty/hunchentoot/misc.lisp 2009-02-11 23:10:20 UTC (rev 4241) @@ -51,8 +51,8 @@ #\= (:greedy-repetition 0 nil (:inverted-char-class #\&)) #\&)))))) - (defun add-cookie-value-to-url (url &key (cookie-name *session-cookie-name*) - (value (session-cookie-value)) + (defun add-cookie-value-to-url (url &key (cookie-name (session-cookie-name *acceptor*)) + (value (session-cookie-value (session *request*))) (replace-ampersands-p t)) "Removes all GET parameters named COOKIE-NAME from URL and then adds a new GET parameter with the name COOKIE-NAME and the value @@ -72,8 +72,8 @@ (setq url (regex-replace-all "&" url "&"))) url)) -(defun maybe-rewrite-urls-for-session (html &key (cookie-name *session-cookie-name*) - (value (session-cookie-value))) +(defun maybe-rewrite-urls-for-session (html &key (cookie-name (session-cookie-name *acceptor*)) + (value (session-cookie-value (session *request*)))) "Rewrites the HTML page HTML such that the name/value pair COOKIE-NAME/COOKIE-VALUE is inserted if the client hasn't sent a cookie of the same name but only if *REWRITE-FOR-SESSION-URLS* is @@ -220,7 +220,7 @@ (protocol (if (ssl-p) :https :http)) (add-session-id (not (or host-provided-p (starts-with-scheme-p target) - (cookie-in *session-cookie-name*)))) + (cookie-in (session-cookie-name *acceptor*))))) (code +http-moved-temporarily+)) "Redirects the browser to TARGET which should be a string. If TARGET is a full URL starting with a scheme, HOST, PORT and PROTOCOL Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 21:44:43 UTC (rev 4240) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 23:10:20 UTC (rev 4241) @@ -64,7 +64,6 @@ "*REQUEST*" "*REWRITE-FOR-SESSION-URLS*" "*SESSION*" - "*SESSION-COOKIE-NAME*" "*SESSION-GC-FREQUENCY*" "*SESSION-MAX-TIME*" "*SESSION-REMOVAL-HOOK*" @@ -157,7 +156,6 @@ "DELETE-SESSION-VALUE" "DISPATCH-EASY-HANDLERS" "DISPATCH-REQUEST" - "DO-SESSIONS" "ESCAPE-FOR-HTML" "EXECUTE-ACCEPTOR" "GET-PARAMETER" @@ -216,14 +214,17 @@ "SEND-HEADERS" "SERVER-PROTOCOL" "SERVER-PROTOCOL*" + "SESSION-COOKIE-NAME" "SESSION-COOKIE-VALUE" - "SESSION-COUNTER" + "SESSION-DB" + "SESSION-DB-LOCK" "SESSION-GC" "SESSION-MAX-TIME" "SESSION-REMOTE-ADDR" "SESSION-TOO-OLD-P" "SESSION-USER-AGENT" "SESSION-VALUE" + "SESSION-VERIFY" "SET-COOKIE" "SET-COOKIE*" "SHUTDOWN" Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 21:44:43 UTC (rev 4240) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:10:20 UTC (rev 4241) @@ -29,10 +29,46 @@ (in-package :hunchentoot) -(defvar *session-data-lock* (make-lock "session-data-lock") - "A lock to prevent two threads from modifying *SESSION-DATA* at the -same time.") +(defgeneric session-db-lock (acceptor &key (whole-db-p t)) + (:documentation "A function which returns a lock that will be used +to prevent concurrent access to sessions. The first argument will be +the acceptor that handles the current request, the second argument is +true if the whole \(current) session database is modified. If it is +NIL, only one existing session in the database is modified. +This function can return NIL which means that sessions or session +databases will be modified without a lock held. The default is to +always return a global lock for Lisps that support threads and NIL +otherwise.")) + +(defmethod session-db-lock ((acceptor t) &key (whole-db-p t)) + (declare (ignore whole-db-p)) + *global-session-db-lock*) + +(defmacro with-session-lock-held ((lock) &body body) + "This is like WITH-LOCK-HELD except that it will accept NIL as a +\"lock\" and just execute BODY in this case." + (with-unique-names (thunk) + (with-rebinding (lock) + `(flet ((,thunk () , at body)) + (cond (,lock (with-lock-held (,lock) (,thunk))) + (t (,thunk))))))) + +(defgeneric session-db (acceptor) + (:documentation "Returns the current session database which is an +alist where each car is a session's ID and the cdr is the +corresponding SESSION object itself. The default is to use a global +list for all acceptors.")) + +(defmethod session-db ((acceptor t)) + *session-db*) + +(defgeneric (setf session-db) (new-value acceptor) + (:documentation "Modifies the current session database. See SESSION-DB.")) + +(defmethod (setf session-db) (new-value (acceptor t)) + (setq *session-db* new-value)) + (let ((session-id-counter 0)) (defun get-next-session-id () "Returns the next sequential session id." @@ -46,7 +82,6 @@ *session-gc-frequency*))) (session-gc)))) - (defclass session () ((session-id :initform (get-next-session-id) :reader session-id @@ -75,21 +110,17 @@ :reader session-data :documentation "Data associated with this session - see SESSION-VALUE.") - (session-counter :initform 0 - :reader session-counter - :documentation "The number of times this session -has been used.") (max-time :initarg :max-time :initform *session-max-time* :accessor session-max-time :type fixnum :documentation "The time \(in seconds) after which this session expires if it's not used.")) - (:documentation "SESSION objects are automatically maintained -by Hunchentoot. They should not be created explicitly with -MAKE-INSTANCE but implicitly with START-SESSION. Note that -SESSION objects can only be created when the special variable -*REQUEST* is bound to a REQUEST object.")) + (:documentation "SESSION objects are automatically maintained by +Hunchentoot. They should not be created explicitly with MAKE-INSTANCE +but implicitly with START-SESSION. Note that SESSION objects can only +be created when the special variable *REQUEST* is bound to a REQUEST +object.")) (defun encode-session-string (id user-agent remote-addr start) "Create a uniquely encoded session string based on the values ID, @@ -121,16 +152,16 @@ (setf (slot-value session 'session-string) (stringify-session session))) (defun session-gc () - "Removes sessions from *session-data* which are too old - see -SESSION-TOO-OLD-P." - (with-lock-held (*session-data-lock*) - (setq *session-data* - (loop for id-session-pair in *session-data* - for (nil . session) = id-session-pair - when (session-too-old-p session) - do (funcall *session-removal-hook* session) - else - collect id-session-pair))) + "Removes sessions from the current session database which are too +old - see SESSION-TOO-OLD-P." + (with-session-lock-held ((session-db-lock *acceptor*)) + (setf (session-db *acceptor*) + (loop for id-session-pair in (session-db *acceptor*) + for (nil . session) = id-session-pair + when (session-too-old-p session) + do (funcall *session-removal-hook* session) + else + collect id-session-pair))) (values)) (defun session-value (symbol &optional (session *session*)) @@ -149,7 +180,7 @@ (with-rebinding (symbol) (with-unique-names (place %session) `(let ((,%session (or ,session (start-session)))) - (with-lock-held (*session-data-lock*) + (with-session-lock-held ((session-db-lock *acceptor* :whole-db-p nil)) (let* ((,place (assoc ,symbol (session-data ,%session) :test #'eq))) (cond (,place @@ -168,17 +199,30 @@ :key #'car :test #'eq))) (values)) -(defun session-cookie-value (&optional (session (session *request*))) - "Returns a string which can be used to safely restore the -session if as session has already been established. This is used -as the value stored in the session cookie or in the corresponding -GET parameter." +(defgeneric session-cookie-value (session) + (:documentation "Returns a string which can be used to safely +restore the session SESSION if as session has already been +established. This is used as the value stored in the session cookie +or in the corresponding GET parameter. A default method is provided +and there's no reason to change it unless you want to use your own +session objects.")) + +(defmethod session-cookie-value ((session session)) (and session (format nil "~A:~A" (session-id session) (session-string session)))) +(defgeneric session-cookie-name (acceptor) + (:documentation "Returns the name \(a string) of the cookie \(or the +GET parameter) which is used to store a session on the client side. +The default is to use the string \"hunchentoot-session\", but you can +specialize this function if you want another name.")) + +(defmethod session-cookie-name ((acceptor t)) + "hunchentoot-session") + (defun start-session () "Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this @@ -189,9 +233,10 @@ (return-from start-session session)) (setf session (make-instance 'session) (session *request*) session) - (with-lock-held (*session-data-lock*) - (setq *session-data* (acons (session-id session) session *session-data*))) - (set-cookie *session-cookie-name* + (with-session-lock-held ((session-db-lock *acceptor*)) + (setf (session-db *acceptor*) + (acons (session-id session) session (session-db *acceptor*)))) + (set-cookie (session-cookie-name *acceptor*) :value (session-cookie-value session) :path "/") (setq *session* session))) @@ -199,11 +244,11 @@ (defun remove-session (session) "Completely removes the SESSION object SESSION from Hunchentoot's internal session database." - (with-lock-held (*session-data-lock*) + (with-session-lock-held ((session-db-lock *acceptor*)) (funcall *session-removal-hook* session) - (setq *session-data* - (delete (session-id session) *session-data* - :key #'car :test #'=))) + (setf (session-db *acceptor*) + (delete (session-id session) (session-db *acceptor*) + :key #'car :test #'=))) (values)) (defun session-too-old-p (session) @@ -217,7 +262,7 @@ session has not expired. Will remove the session if it has expired but will not create a new one." (let ((session - (cdr (assoc id *session-data* :test #'=)))) + (cdr (assoc id (session-db *acceptor*) :test #'=)))) (when (and session (session-too-old-p session)) (when *reply* @@ -226,14 +271,19 @@ (setq session nil)) session)) -(defun session-verify (request) - "Tries to get a session identifier from the cookies \(or -alternatively from the GET parameters) sent by the client. This +(defgeneric session-verify (request) + (:documentation "Tries to get a session identifier from the cookies +\(or alternatively from the GET parameters) sent by the client. This identifier is then checked for validity against the REQUEST object -REQUEST. On success the corresponding session object \(if not too old) -is returned \(and updated). Otherwise NIL is returned." - (let ((session-identifier (or (cookie-in *session-cookie-name* request) - (get-parameter *session-cookie-name* request)))) +REQUEST. On success the corresponding session object \(if not too +old) is returned \(and updated). Otherwise NIL is returned. + +A default method is provided and you only need to write your own one +if you want to maintain your own sessions.")) + +(defmethod session-verify ((request request)) + (let ((session-identifier (or (cookie-in (session-cookie-name *acceptor*) request) + (get-parameter (session-cookie-name *acceptor*) request)))) (unless (and session-identifier (stringp session-identifier) (plusp (length session-identifier))) @@ -245,36 +295,35 @@ (user-agent (user-agent request)) (remote-addr (remote-addr request))) (cond - ((and session - (string= session-string - (session-string session)) - (string= session-string - (encode-session-string id - user-agent - (real-remote-addr request) - (session-start session)))) - ;; The session key presented by the client is valid. - (incf (slot-value session 'session-counter)) - (setf (slot-value session 'last-click) (get-universal-time)) - session) - (session - ;; The session ID pointed to an existing session, but the - ;; session string did not match the expected session - ;; string. Report to the log file, remove the session to - ;; make sure that it can't be used again. The original - ;; legitimate user will be required to log in again. - (log-message* :warning - "Fake session identifier '~A' (User-Agent: '~A', IP: '~A')" - session-identifier user-agent remote-addr) - (remove-session session) - nil) - (t - ;; No session was found under the ID given, presumably - ;; because it has expired. - (log-message* :info - "No session for session identifier '~A' (User-Agent: '~A', IP: '~A')" - session-identifier user-agent remote-addr) - nil)))))) + ((and session + (string= session-string + (session-string session)) + (string= session-string + (encode-session-string id + user-agent + (real-remote-addr request) + (session-start session)))) + ;; The session key presented by the client is valid. + (setf (slot-value session 'last-click) (get-universal-time)) + session) + (session + ;; The session ID pointed to an existing session, but the + ;; session string did not match the expected session + ;; string. Report to the log file, remove the session to + ;; make sure that it can't be used again. The original + ;; legitimate user will be required to log in again. + (log-message* :warning + "Fake session identifier '~A' (User-Agent: '~A', IP: '~A')" + session-identifier user-agent remote-addr) + (remove-session session) + nil) + (t + ;; No session was found under the ID given, presumably + ;; because it has expired. + (log-message* :info + "No session for session identifier '~A' (User-Agent: '~A', IP: '~A')" + session-identifier user-agent remote-addr) + nil)))))) (defun reset-session-secret () "Sets *SESSION-SECRET* to a new random value. All old sessions will @@ -283,18 +332,8 @@ (defun reset-sessions () "Removes ALL stored sessions." - (with-lock-held (*session-data-lock*) - (loop for (nil . session) in *session-data* + (with-session-lock-held ((session-db-lock *acceptor*)) + (loop for (nil . session) in (session-db *acceptor*) do (funcall *session-removal-hook* session)) - (setq *session-data* nil)) - (values)) - -(defmacro do-sessions ((var &optional result-form) &body body) - "Executes BODY with VAR bound to each existing SESSION object -consecutively. Returns the values returned by RESULT-FORM unless -RETURN is executed. The scope of the binding of VAR does not include -RESULT-FORM." - (let ((=temp= (gensym))) - `(dolist (,=temp= *session-data* ,result-form) - (let ((,var (cdr ,=temp=))) - , at body)))) \ No newline at end of file + (setq *session-db* nil)) + (values)) \ No newline at end of file Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 21:44:43 UTC (rev 4240) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 23:10:20 UTC (rev 4241) @@ -120,10 +120,6 @@ "The three-character names of the twelve months - needed for cookie date format.") -(defvar *session-cookie-name* "hunchentoot-session" - "The name of the cookie \(or the GET parameter) which is used to -store the session on the client side.") - (defvar *rewrite-for-session-urls* t "Whether HTML pages should possibly be rewritten for cookie-less session-management.") @@ -161,10 +157,8 @@ the uploaded file is written. The hook is called directly before the file is created.") -(defvar *session-data* nil - "All sessions of all users currently using Hunchentoot. An -alist where the car is the session's ID and the cdr is the -SESSION object itself.") +(defvar *session-db* nil + "The default \(global) session database.") (defvar *session-max-time* #.(* 30 60) "The default time \(in seconds) after which a session times out.") @@ -313,6 +307,11 @@ #+:lispworks t #-:lispworks bt:*supports-threads-p*) +(defvar *global-session-db-lock* + (load-time-value (and *supports-threads-p* (make-lock "global-session-db-lock"))) + "A global lock to prevent two threads from modifying *session-db* at +the same time \(or NIL for Lisps which don't have threads).") + (defconstant +new-connection-wait-time+ 2 "Time in seconds to wait for a new connection to arrive before performing a cleanup run.") Modified: trunk/thirdparty/hunchentoot/test/test-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-11 21:44:43 UTC (rev 4240) +++ trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-11 23:10:20 UTC (rev 4241) @@ -198,8 +198,8 @@ (:input :type :text :name "new-bar-value" :value (or (session-value 'bar) "")))) - (info-table *session-cookie-name* - (cookie-in *session-cookie-name*) + (info-table (session-cookie-name *acceptor*) + (cookie-in (session-cookie-name *acceptor*)) (mapcar #'car (cookies-in*)) (session-value 'foo) (session-value 'bar)))))) From bknr at bknr.net Wed Feb 11 23:42:18 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 00:42:18 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4242 Author: edi URL: http://bknr.net/trac/changeset/4242 More session changes U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -179,6 +179,7 @@ "LOG-FILE" "LOG-MESSAGE" "MIME-TYPE" + "NEXT-SESSION-ID" "NO-CACHE" "PARAMETER" "POST-PARAMETER" @@ -199,6 +200,7 @@ "REMOVE-SESSION" "REPLY-EXTERNAL-FORMAT" "REQUEST" + "REQUEST-ACCEPTOR" "REQUEST-METHOD" "REQUEST-METHOD*" "REQUEST-URI" @@ -216,6 +218,7 @@ "SERVER-PROTOCOL*" "SESSION-COOKIE-NAME" "SESSION-COOKIE-VALUE" + "SESSION-CREATED" "SESSION-DB" "SESSION-DB-LOCK" "SESSION-GC" Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -30,7 +30,10 @@ (in-package :hunchentoot) (defclass request () - ((headers-in :initarg :headers-in + ((acceptor :initarg :acceptor + :documentation "The acceptor which created this request object." + :reader request-acceptor) + (headers-in :initarg :headers-in :documentation "An alist of the incoming headers." :reader headers-in) (method :initarg :method Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -69,21 +69,19 @@ (defmethod (setf session-db) (new-value (acceptor t)) (setq *session-db* new-value)) +(defgeneric next-session-id (acceptor) + (:documentation "Returns the next sequential session ID, an integer, +which should be unique per session. The default method uses a simple +global counter and isn't guarded by a lock. For a high-performance +production environment you might consider to use a more robust +method.")) + (let ((session-id-counter 0)) - (defun get-next-session-id () - "Returns the next sequential session id." + (defmethod next-session-id ((acceptor t)) (incf session-id-counter))) -(let ((global-session-usage-counter 0)) - (defun count-session-usage () - "Counts session usage globally and triggers session gc if necessary." - (when (and *session-gc-frequency* - (zerop (mod (incf global-session-usage-counter) - *session-gc-frequency*))) - (session-gc)))) - (defclass session () - ((session-id :initform (get-next-session-id) + ((session-id :initform (next-session-id (request-acceptor *request*)) :reader session-id :type integer :documentation "The unique ID \(an INTEGER) of the session.") @@ -118,12 +116,10 @@ session expires if it's not used.")) (:documentation "SESSION objects are automatically maintained by Hunchentoot. They should not be created explicitly with MAKE-INSTANCE -but implicitly with START-SESSION. Note that SESSION objects can only -be created when the special variable *REQUEST* is bound to a REQUEST -object.")) +but implicitly with START-SESSION.")) (defun encode-session-string (id user-agent remote-addr start) - "Create a uniquely encoded session string based on the values ID, + "Creates a uniquely encoded session string based on the values ID, USER-AGENT, REMOTE-ADDR, and START" ;; *SESSION-SECRET* is used twice due to known theoretical ;; vulnerabilities of MD5 encoding @@ -223,11 +219,24 @@ (defmethod session-cookie-name ((acceptor t)) "hunchentoot-session") +(defgeneric session-created (acceptor new-session) + (:documentation "This function is called whenever a new session has +been created. There's a default method which might trigger a session +GC based on the value of *SESSION-GC-FREQUENCY*.")) + +(let ((global-session-usage-counter 0)) + (defmethod session-created ((acceptor t) (session t)) + "Counts session usage globally and triggers session GC if +necessary." + (when (and *session-gc-frequency* + (zerop (mod (incf global-session-usage-counter) + *session-gc-frequency*))) + (session-gc)))) + (defun start-session () "Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this case the function will also send a session cookie to the browser." - (count-session-usage) (let ((session (session *request*))) (when session (return-from start-session session)) @@ -239,6 +248,7 @@ (set-cookie (session-cookie-name *acceptor*) :value (session-cookie-value session) :path "/") + (session-created *acceptor* session) (setq *session* session))) (defun remove-session (session) @@ -303,22 +313,22 @@ user-agent (real-remote-addr request) (session-start session)))) - ;; The session key presented by the client is valid. + ;; the session key presented by the client is valid (setf (slot-value session 'last-click) (get-universal-time)) session) (session - ;; The session ID pointed to an existing session, but the - ;; session string did not match the expected session - ;; string. Report to the log file, remove the session to - ;; make sure that it can't be used again. The original - ;; legitimate user will be required to log in again. + ;; the session ID pointed to an existing session, but the + ;; session string did not match the expected session string (log-message* :warning "Fake session identifier '~A' (User-Agent: '~A', IP: '~A')" session-identifier user-agent remote-addr) + ;; remove the session to make sure that it can't be used + ;; again; the original legitimate user will be required to + ;; log in again (remove-session session) nil) (t - ;; No session was found under the ID given, presumably + ;; no session was found under the ID given, presumably ;; because it has expired. (log-message* :info "No session for session identifier '~A' (User-Agent: '~A', IP: '~A')" Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -165,8 +165,8 @@ (defvar *session-gc-frequency* 50 "A session GC \(see function SESSION-GC) will happen every -*SESSION-GC-FREQUENCY* requests \(counting only requests which -use a session) if this variable is not NIL.") +*SESSION-GC-FREQUENCY* requests \(counting only requests which create +a new session) if this variable is not NIL. See SESSION-CREATED.") (defvar *use-user-agent-for-sessions* t "Whether the 'User-Agent' header should be encoded into the session From bknr at bknr.net Wed Feb 11 23:54:40 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 00:54:40 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4243 Author: edi URL: http://bknr.net/trac/changeset/4243 Integrate url-rewrite U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/hunchentoot.asd A trunk/thirdparty/hunchentoot/url-rewrite/ A trunk/thirdparty/hunchentoot/url-rewrite/packages.lisp A trunk/thirdparty/hunchentoot/url-rewrite/primitives.lisp A trunk/thirdparty/hunchentoot/url-rewrite/specials.lisp A trunk/thirdparty/hunchentoot/url-rewrite/url-rewrite.lisp A trunk/thirdparty/hunchentoot/url-rewrite/util.lisp Change set too large, please see URL above From bknr at bknr.net Thu Feb 12 09:04:52 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 10:04:52 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4244 Author: hans URL: http://bknr.net/trac/changeset/4244 Compilation fixes for non-Lispworks. Compiles, but does not run yet. A trunk/thirdparty/hunchentoot/compat.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/util.lisp Added: trunk/thirdparty/hunchentoot/compat.lisp =================================================================== --- trunk/thirdparty/hunchentoot/compat.lisp (rev 0) +++ trunk/thirdparty/hunchentoot/compat.lisp 2009-02-12 09:04:52 UTC (rev 4244) @@ -0,0 +1,114 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/hunchentoot/util.lisp,v 1.35 2008/04/08 14:39:18 edi Exp $ + +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :hunchentoot) + +(defmacro when-let ((var form) &body body) + "Evaluates FORM and binds VAR to the result, then executes BODY +if VAR has a true value." + `(let ((,var ,form)) + (when ,var , at body))) + +(defmacro with-unique-names ((&rest bindings) &body body) + "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form* + +Executes a series of forms with each VAR bound to a fresh, +uninterned symbol. The uninterned symbol is as if returned by a call +to GENSYM with the string denoted by X - or, if X is not supplied, the +string denoted by VAR - as argument. + +The variable bindings created are lexical unless special declarations +are specified. The scopes of the name bindings and declarations do not +include the Xs. + +The forms are evaluated in order, and the values of all but the last +are discarded \(that is, the body is an implicit PROGN)." + ;; reference implementation posted to comp.lang.lisp as + ;; by Vebjorn Ljosa - see also + ;; + `(let ,(mapcar #'(lambda (binding) + (check-type binding (or cons symbol)) + (if (consp binding) + (destructuring-bind (var x) binding + (check-type var symbol) + `(,var (gensym ,(etypecase x + (symbol (symbol-name x)) + (character (string x)) + (string x))))) + `(,binding (gensym ,(symbol-name binding))))) + bindings) + , at body)) + +(defmacro with-rebinding (bindings &body body) + "Syntax: WITH-REBINDING ( { var | (var prefix) }* ) form* + +Evaluates a series of forms in the lexical environment that is +formed by adding the binding of each VAR to a fresh, uninterned +symbol, and the binding of that fresh, uninterned symbol to VAR's +original value, i.e., its value in the current lexical environment. + +The uninterned symbol is created as if by a call to GENSYM with the +string denoted by PREFIX - or, if PREFIX is not supplied, the string +denoted by VAR - as argument. + +The forms are evaluated in order, and the values of all but the last +are discarded \(that is, the body is an implicit PROGN)." + ;; reference implementation posted to comp.lang.lisp as + ;; by Vebjorn Ljosa - see also + ;; + (loop for binding in bindings + for var = (if (consp binding) (car binding) binding) + for name = (gensym) + collect `(,name ,var) into renames + collect ``(,,var ,,name) into temps + finally (return `(let ,renames + (with-unique-names ,bindings + `(let (,, at temps) + ,, at body)))))) + +(defun get-peer-address-and-port (socket) + "Returns the peer address and port of the socket SOCKET as two +values. The address is returned as a string in dotted IP address +notation." + (values (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket)) + (usocket:get-peer-port socket))) + +(defun make-socket-stream (socket server) + "Returns a stream for the socket SOCKET. The SERVER argument is +ignored." + (declare (ignore server)) + (usocket:socket-stream socket)) + +(defun make-lock (name) + "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." + (bt:make-lock name)) + +(defmacro with-lock-held ((lock) &body body) + "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." + `(bt:with-lock-held (,lock) , at body)) \ No newline at end of file Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-11 23:54:40 UTC (rev 4243) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 09:04:52 UTC (rev 4244) @@ -63,6 +63,8 @@ (:file "packages") #+:lispworks (:file "lispworks") + #-:lispworks + (:file "compat") (:file "specials") (:file "conditions") (:file "mime-types") Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:54:40 UTC (rev 4243) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-12 09:04:52 UTC (rev 4244) @@ -29,7 +29,7 @@ (in-package :hunchentoot) -(defgeneric session-db-lock (acceptor &key (whole-db-p t)) +(defgeneric session-db-lock (acceptor &key whole-db-p) (:documentation "A function which returns a lock that will be used to prevent concurrent access to sessions. The first argument will be the acceptor that handles the current request, the second argument is Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-11 23:54:40 UTC (rev 4243) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-12 09:04:52 UTC (rev 4244) @@ -29,72 +29,7 @@ (in-package :hunchentoot) -#-:lispworks -(defmacro when-let ((var form) &body body) - "Evaluates FORM and binds VAR to the result, then executes BODY -if VAR has a true value." - `(let ((,var ,form)) - (when ,var , at body))) -#-:lispworks -(defmacro with-unique-names ((&rest bindings) &body body) - "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form* - -Executes a series of forms with each VAR bound to a fresh, -uninterned symbol. The uninterned symbol is as if returned by a call -to GENSYM with the string denoted by X - or, if X is not supplied, the -string denoted by VAR - as argument. - -The variable bindings created are lexical unless special declarations -are specified. The scopes of the name bindings and declarations do not -include the Xs. - -The forms are evaluated in order, and the values of all but the last -are discarded \(that is, the body is an implicit PROGN)." - ;; reference implementation posted to comp.lang.lisp as - ;; by Vebjorn Ljosa - see also - ;; - `(let ,(mapcar #'(lambda (binding) - (check-type binding (or cons symbol)) - (if (consp binding) - (destructuring-bind (var x) binding - (check-type var symbol) - `(,var (gensym ,(etypecase x - (symbol (symbol-name x)) - (character (string x)) - (string x))))) - `(,binding (gensym ,(symbol-name binding))))) - bindings) - , at body)) - -#-:lispworks -(defmacro with-rebinding (bindings &body body) - "Syntax: WITH-REBINDING ( { var | (var prefix) }* ) form* - -Evaluates a series of forms in the lexical environment that is -formed by adding the binding of each VAR to a fresh, uninterned -symbol, and the binding of that fresh, uninterned symbol to VAR's -original value, i.e., its value in the current lexical environment. - -The uninterned symbol is created as if by a call to GENSYM with the -string denoted by PREFIX - or, if PREFIX is not supplied, the string -denoted by VAR - as argument. - -The forms are evaluated in order, and the values of all but the last -are discarded \(that is, the body is an implicit PROGN)." - ;; reference implementation posted to comp.lang.lisp as - ;; by Vebjorn Ljosa - see also - ;; - (loop for binding in bindings - for var = (if (consp binding) (car binding) binding) - for name = (gensym) - collect `(,name ,var) into renames - collect ``(,,var ,,name) into temps - finally (return `(let ,renames - (with-unique-names ,bindings - `(let (,, at temps) - ,, at body)))))) - (defun starts-with-p (seq subseq &key (test 'eql)) "Tests whether the sequence SEQ starts with the sequence SUBSEQ. Individual elements are compared with TEST." @@ -385,27 +320,3 @@ "Whether the current connection to the client is secure." (acceptor-ssl-p acceptor)) -#-:lispworks -(defun get-peer-address-and-port (socket) - "Returns the peer address and port of the socket SOCKET as two -values. The address is returned as a string in dotted IP address -notation." - (values (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket)) - (usocket:get-peer-port socket))) - -#-:lispworks -(defun make-socket-stream (socket server) - "Returns a stream for the socket SOCKET. The SERVER argument is -ignored." - (declare (ignore server)) - (usocket:socket-stream socket)) - -#-:lispworks -(defun make-lock (name) - "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." - (bt:make-lock name)) - -#-:lispworks -(defmacro with-lock-held ((lock) &body body) - "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." - `(bt:with-lock-held (,lock) , at body)) \ No newline at end of file From bknr at bknr.net Thu Feb 12 17:00:04 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 18:00:04 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4245 Author: hans URL: http://bknr.net/trac/changeset/4245 Only try to set timeout if not NIL. Only try to rewrite when a session has been set up. U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/set-timeouts.lisp Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-12 09:04:52 UTC (rev 4244) +++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-12 17:00:04 UTC (rev 4245) @@ -177,6 +177,7 @@ (write-sequence +crlf+ *hunchentoot-stream*) (maybe-write-to-header-stream first-line)) (when (and (stringp content) + (session *request*) (not content-modified-p) (starts-with-one-of-p (or (content-type) "") *content-types-for-url-rewrite*)) Modified: trunk/thirdparty/hunchentoot/set-timeouts.lisp =================================================================== --- trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-12 09:04:52 UTC (rev 4244) +++ trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-12 17:00:04 UTC (rev 4245) @@ -61,8 +61,9 @@ (setf (ccl:stream-output-timeout (usocket:socket usocket)) write-timeout)) #+:sbcl - (setf (sb-impl::fd-stream-timeout (usocket:socket-stream usocket)) - (coerce read-timeout 'single-float)) + (when read-timeout + (setf (sb-impl::fd-stream-timeout (usocket:socket-stream usocket)) + (coerce read-timeout 'single-float))) #+:cmu (setf (lisp::fd-stream-timeout (usocket:socket-stream usocket)) (coerce read-timeout 'integer)) From bknr at bknr.net Thu Feb 12 20:54:43 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 21:54:43 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/test/test-handlers.lisp Message-ID: Revision: 4246 Author: edi URL: http://bknr.net/trac/changeset/4246 Fix wrong link due to renaming U trunk/thirdparty/hunchentoot/test/test-handlers.lisp Modified: trunk/thirdparty/hunchentoot/test/test-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-12 17:00:04 UTC (rev 4245) +++ trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-12 20:54:43 UTC (rev 4246) @@ -488,7 +488,7 @@ (:tr (:td (:a :href "/hunchentoot/test/authorization.html" "Authorization") " (user 'nanook', password 'igloo')")) - (:tr (:td (:a :href "/hunchentoot/code/test.lisp" + (:tr (:td (:a :href "/hunchentoot/code/test-handlers.lisp" "The source code of this test"))) (:tr (:td (:a :href "/hunchentoot/test/image.jpg" "Binary data, delivered from file") From bknr at bknr.net Thu Feb 12 21:18:29 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 22:18:29 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4247 Author: edi URL: http://bknr.net/trac/changeset/4247 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/ssl.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 20:54:43 UTC (rev 4246) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 21:18:29 UTC (rev 4247) @@ -268,6 +268,7 @@ (multiple-value-bind (remote-addr remote-port) (get-peer-address-and-port socket) (process-request (make-instance (acceptor-request-class *acceptor*) + :acceptor *acceptor* :remote-addr remote-addr :remote-port remote-port :headers-in headers-in @@ -319,7 +320,10 @@ (when error (setf (return-code *reply*) +http-internal-server-error+)) - (start-output :content (cond (error + (start-output :content (cond ((and error *show-lisp-errors-p*) + (format nil "

      ~A
      " + (escape-for-html (format nil "~A" error)))) + (error "An error has occured.") (t body)))) t) Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 20:54:43 UTC (rev 4246) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 21:18:29 UTC (rev 4247) @@ -61,10 +61,8 @@ (:file "util") (:file "url-rewrite"))) (:file "packages") - #+:lispworks - (:file "lispworks") - #-:lispworks - (:file "compat") + #+:lispworks (:file "lispworks") + #-:lispworks (:file "compat") (:file "specials") (:file "conditions") (:file "mime-types") @@ -80,5 +78,4 @@ (:file "set-timeouts") (:file "connection-dispatcher") (:file "acceptor") - #-:hunchentoot-no-ssl - (:file "ssl"))) + #-:hunchentoot-no-ssl (:file "ssl"))) Modified: trunk/thirdparty/hunchentoot/log.lisp =================================================================== --- trunk/thirdparty/hunchentoot/log.lisp 2009-02-12 20:54:43 UTC (rev 4246) +++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-12 21:18:29 UTC (rev 4247) @@ -100,7 +100,7 @@ (setf (log-file-pathname ,special-variable) pathname))))) (define-log-file log-file *log-file* *log-pathname* - "file to use to log general messages.") + "File to use to log general messages.") (defmethod log-message (log-level format &rest args) "Sends a formatted message to the file denoted by *LOG-FILE*. @@ -113,7 +113,7 @@ (defun log-message* (log-level format &rest args) "Internal function accepting the same arguments as LOG-MESSAGE and -using the message logger of *SERVER* \(if there is one)." +using the message logger of *ACCEPTOR* \(if there is one)." (when-let (message-logger (acceptor-message-logger *acceptor*)) (apply message-logger log-level format args))) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 20:54:43 UTC (rev 4246) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 21:18:29 UTC (rev 4247) @@ -127,6 +127,9 @@ "ACCEPTOR-REQUEST-CLASS" "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-SSL-P" + "ACCEPTOR-SSL-CERTIFICATE-FILE" + "ACCEPTOR-SSL-PRIVATEKEY-FILE" + "ACCEPTOR-SSL-PRIVATEKEY-PASSWORD" "ACCEPTOR-WRITE-TIMEOUT" "ACCESS-LOG-FILE" "AUTHORIZATION" @@ -231,6 +234,7 @@ "SET-COOKIE" "SET-COOKIE*" "SHUTDOWN" + "SSL-ACCEPTOR" "SSL-P" "START" "START-LISTENING" Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-12 20:54:43 UTC (rev 4246) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-12 21:18:29 UTC (rev 4247) @@ -44,21 +44,38 @@ :reader acceptor-ssl-privatekey-password :documentation "The password for the private key file or NIL.")) - (:default-initargs :port 443 :output-chunking-p nil) + (:default-initargs + :port 443 + :input-chunking-p nil + :output-chunking-p nil) (:documentation "This class defines additional slots required to -serve requests by SSL")) +serve requests via SSL.")) -(defmethod initialize-instance :around ((acceptor ssl-acceptor) - &rest args - &key ssl-certificate-file ssl-privatekey-file - &allow-other-keys) - (apply #'call-next-method acceptor - :ssl-certificate-file (namestring ssl-certificate-file) - :ssl-privatekey-file (namestring (or ssl-privatekey-file - #+:lispworks - ssl-certificate-file)) - args)) +;; general implementation +(defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) + t) + +;; usocket implementation + +#-:lispworks +(defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream) + ;; attach SSL to the stream if necessary + (call-next-method acceptor + (cl+ssl:make-ssl-server-stream stream + :certificate (acceptor-ssl-certificate-file acceptor) + :key (acceptor-ssl-privatekey-file acceptor)))) + +;; LispWorks implementation + +#+:lispworks +(defmethod initialize-instance :after ((acceptor ssl-acceptor) &rest initargs) + (declare (ignore initargs)) + ;; LispWorks can read both from the same file, so we can default one + (unless (slot-boundp acceptor 'ssl-privatekey-file) + (setf (slot-value acceptor 'ssl-privatekey-file) + (acceptor-ssl-certificate-file acceptor)))) + #+lispworks (defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the @@ -80,19 +97,11 @@ :ctx-configure-callback #'ctx-configure-callback) socket-stream)) - -(defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) - t) - +#+:lispworks (defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream) ;; attach SSL to the stream if necessary (call-next-method acceptor - #+:lispworks (make-ssl-server-stream stream :certificate-file (acceptor-ssl-certificate-file acceptor) :privatekey-file (acceptor-ssl-privatekey-file acceptor) - :privatekey-password (acceptor-ssl-privatekey-password acceptor)) - #-:lispworks - (cl+ssl:make-ssl-server-stream stream - :certificate (acceptor-ssl-certificate-file acceptor) - :key (acceptor-ssl-privatekey-file acceptor)))) \ No newline at end of file + :privatekey-password (acceptor-ssl-privatekey-password acceptor)))) \ No newline at end of file From bknr at bknr.net Thu Feb 12 21:21:09 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 22:21:09 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/documentation-template/doc/clixdoc.xsl Message-ID: Revision: 4248 Author: edi URL: http://bknr.net/trac/changeset/4248 Adapt Hans' changes from Hunchentoot U trunk/thirdparty/documentation-template/doc/clixdoc.xsl Modified: trunk/thirdparty/documentation-template/doc/clixdoc.xsl =================================================================== --- trunk/thirdparty/documentation-template/doc/clixdoc.xsl 2009-02-12 21:18:29 UTC (rev 4247) +++ trunk/thirdparty/documentation-template/doc/clixdoc.xsl 2009-02-12 21:21:09 UTC (rev 4248) @@ -39,6 +39,8 @@ omit-xml-declaration="yes" doctype-public="-//W3C//DTD HTML 4.0 Strict//EN" /> + + @@ -50,6 +52,7 @@ pre { padding:5px; background-color:#e0e0e0 } pre.none { padding:5px; background-color:#ffffff } h3, h4, h5 { text-decoration: underline; } + .entry-type { padding-left: 1em; font-size: 60%; font-style: italic } a { text-decoration: none; padding: 1px 2px 1px 2px; } a:visited { text-decoration: none; padding: 1px 2px 1px 2px; } a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; } @@ -75,25 +78,16 @@

      - - [Generic function] - [Method] - [Macro] - [Function] - + + []
      - - - - - - - - - => - - - + + + + + => + +

      @@ -102,24 +96,16 @@

      - - [Generic reader] - [Specialized reader] - [Reader] - + + []
      - - - - - - - - - => - - - + + + + + => + +

      @@ -128,24 +114,16 @@

      - - [Generic writer] - [Specialized writer] - [Writer] - + + []
      - - - - - (setf ( - - ) new-value) - - => - - - + (setf ( + + ) new-value) + + => + +

      @@ -154,112 +132,38 @@

      - - [Generic accessor] - [Specialized accessor] - [Accessor] - + + []
      - - - - - - - - => - -
      - (setf ( - - ) new-value) -       + + + + => + +
      + (setf ( + + ) new-value)

      - +

      - [Special variable]
      - - - - - - + + [] +
      +

      - -

      - [Standard class]
      - - - - - - -

      - -
      -

      -       - - -

      - [Condition type]
      - - - - - - -

      - -
      -

      -       - - -

      - [Symbol]
      - - - - - - -

      - -
      -

      -       - - -

      - [Constant]
      - - - - - - -

      - -
      -

      -       - - - - - +
      @@ -289,19 +193,6 @@       - - - - - - - # - - - - - - @@ -355,12 +246,37 @@
        - +
      • - - - + + + + + + + + + + + + + + +
          + + +
        • + + + + + +
          • +           +
        +         +
      @@ -373,4 +289,91 @@       + + + + + + + + # + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + Generic function + Method + Macro + Function + + + + + Generic reader + Specialized reader + Reader + + + + + Generic writer + Specialized writer + Writer + + + + + Generic accessor + Specialized accessor + Accessor + + + Special variable + Standard class + Condition type + Symbol + Constant + Constant + + + + + + From bknr at bknr.net Thu Feb 12 22:33:37 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 12 Feb 2009 23:33:37 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4249 Author: edi URL: http://bknr.net/trac/changeset/4249 First stab at logging U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/test/packages.lisp U trunk/thirdparty/hunchentoot/test/script.lisp Change set too large, please see URL above From bknr at bknr.net Thu Feb 12 23:09:58 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 13 Feb 2009 00:09:58 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4250 Author: edi URL: http://bknr.net/trac/changeset/4250 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/test/test-handlers.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -44,10 +44,12 @@ :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol naming) a class which inherits from REQUEST.") - (request-dispatcher :initarg :request-dispatcher - :accessor acceptor-request-dispatcher - :documentation "The dispatcher function used by -this acceptor.") + (handler-selector :initarg :handler-selector + :accessor acceptor-handler-selector + :documentation "The handler selector function +used by this acceptor. A function which accepts a REQUEST object and +calls a request handler of its choice \(and returns its return +value).") (connection-dispatcher :initarg :connection-dispatcher :reader acceptor-connection-dispatcher :documentation "The connection dispatcher that is @@ -121,7 +123,7 @@ :port 80 :name (gensym) :request-class 'request - :request-dispatcher 'dispatch-request + :handler-selector 'list-handler-selector :connection-dispatcher (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-dispatcher) (t 'single-threaded-connection-dispatcher))) :output-chunking-p t @@ -322,7 +324,7 @@ ;; skip dispatch if bad request (when (eql (return-code) +http-ok+) ;; now do the work - (funcall (acceptor-request-dispatcher *acceptor*) *request* *reply*)))) + (funcall (acceptor-handler-selector *acceptor*) *request*)))) (when error (setf (return-code *reply*) +http-internal-server-error+)) @@ -406,12 +408,12 @@ (defmethod accept-connections ((acceptor acceptor)) (mp:process-unstop (acceptor-process acceptor))) -;;; TODO -(defgeneric dispatch-request (request reply) - (:documentation "") - (:method (request reply) - (loop for dispatcher in *dispatch-table* - for action = (funcall dispatcher request) - when action return (funcall action) - finally (setf (return-code reply) +http-not-found+)))) +(defun list-handler-selector (request) + "The default handler selector which selects a request handler based +on a list of individual request dispatchers all of which can either +return a handler or neglect by returning NIL." + (loop for dispatcher in *dispatch-table* + for action = (funcall dispatcher request) + when action return (funcall action) + finally (setf (return-code *reply*) +http-not-found+))) Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/misc.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -128,6 +128,12 @@ (and (scan scanner (script-name request)) handler)))) +(defun abort-request-handler (&optional result) + "This function can be called by a request handler at any time to +immediately abort handling the request. This works as if the handler +had returned RESULT. See the source code of REDIRECT for an example." + (throw 'handler-done result)) + (defun handle-static-file (path &optional content-type) "A function which acts like a Hunchentoot handler for the file denoted by PATH. Send a content type header corresponding to @@ -138,7 +144,7 @@ (fad:directory-exists-p path)) ;; does not exist (setf (return-code) +http-not-found+) - (throw 'handler-done nil)) + (abort-request-handler)) (let ((time (or (file-write-date path) (get-universal-time)))) (setf (content-type) (or content-type (mime-type path) @@ -203,7 +209,7 @@ (loop for component in (rest script-path-directory) always (stringp component)))) (setf (return-code) +http-forbidden+) - (throw 'handler-done nil)) + (abort-request-handler)) (handle-static-file (merge-pathnames script-path base-path) content-type)))) (create-prefix-dispatcher uri-prefix #'handler))) @@ -248,7 +254,7 @@ (setq url (add-cookie-value-to-url url :replace-ampersands-p nil))) (setf (header-out :location) url (return-code *reply*) code) - (throw 'handler-done nil))) + (abort-request-handler))) (defun require-authorization (&optional (realm "Hunchentoot")) "Sends back appropriate headers to require basic HTTP authentication @@ -257,4 +263,4 @@ (format nil "Basic realm=\"~A\"" (quote-string realm)) (return-code *reply*) +http-authorization-required+) - (throw 'handler-done nil)) + (abort-request-handler)) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -116,9 +116,11 @@ "+HTTP-UNSUPPORTED-MEDIA-TYPE+" "+HTTP-USE-PROXY+" "+HTTP-VERSION-NOT-SUPPORTED+" + "ABORT-REQUEST-HANDLER" "ACCEPTOR" "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" + "ACCEPTOR-HANDLER-SELECTOR" "ACCEPTOR-INPUT-CHUNKING-P" "ACCEPTOR-MESSAGE-LOGGER" "ACCEPTOR-NAME" @@ -127,7 +129,6 @@ "ACCEPTOR-PORT" "ACCEPTOR-READ-TIMEOUT" "ACCEPTOR-REQUEST-CLASS" - "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-SSL-P" "ACCEPTOR-SSL-CERTIFICATE-FILE" "ACCEPTOR-SSL-PRIVATEKEY-FILE" @@ -159,7 +160,6 @@ "DELETE-AUX-REQUEST-VALUE" "DELETE-SESSION-VALUE" "DISPATCH-EASY-HANDLERS" - "DISPATCH-REQUEST" "ESCAPE-FOR-HTML" "EXECUTE-ACCEPTOR" "GET-PARAMETER" @@ -168,7 +168,6 @@ "HANDLE-INCOMING-CONNECTION" "HANDLE-IF-MODIFIED-SINCE" "HANDLE-STATIC-FILE" - "HANDLER-DONE" "HEADER-IN" "HEADER-IN*" "HEADER-OUT" Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -397,7 +397,7 @@ (when (and if-modified-since (equal if-modified-since time-string)) (setf (return-code) +http-not-modified+) - (throw 'handler-done nil)) + (abort-request-handler)) (values))) (defun external-format-from-content-type (content-type) Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -255,7 +255,7 @@ #+:openmcl "http://openmcl.clozure.com/" "A link to the website of the underlying Lisp implementation.") -(defvar *dispatch-table* (list 'default-dispatcher) +(defvar *dispatch-table* (list 'dispatch-easy-handlers 'default-dispatcher) "A global list of dispatch functions.") (defvar *default-handler* 'default-handler Modified: trunk/thirdparty/hunchentoot/test/test-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-12 22:33:37 UTC (rev 4249) +++ trunk/thirdparty/hunchentoot/test/test-handlers.lisp 2009-02-12 23:09:58 UTC (rev 4250) @@ -161,7 +161,7 @@ " cookie test") (:p "You might have to reload this page to see the cookie value.") (info-table (cookie-in "pumpkin") - (mapcar #'car (cookies-in*))))))) + (mapcar 'car (cookies-in*))))))) (defun session-test () (let ((new-foo-value (post-parameter "new-foo-value"))) @@ -200,7 +200,7 @@ :value (or (session-value 'bar) "")))) (info-table (session-cookie-name *acceptor*) (cookie-in (session-cookie-name *acceptor*)) - (mapcar #'car (cookies-in*)) + (mapcar 'car (cookies-in*)) (session-value 'foo) (session-value 'bar)))))) @@ -225,10 +225,10 @@ :name "foo"))) (case method (:get (info-table (query-string*) - (map 'list #'char-code (get-parameter "foo")) + (map 'list 'char-code (get-parameter "foo")) (get-parameter "foo"))) (:post (info-table (raw-post-data) - (map 'list #'char-code (post-parameter "foo")) + (map 'list 'char-code (post-parameter "foo")) (post-parameter "foo")))))))) (defun parameter-test-latin1-get () @@ -262,7 +262,7 @@ :type nil :defaults *tmp-test-directory*))) ;; strip directory info sent by Windows browsers - (when (search "Windows" (user-agent) :test #'char-equal) + (when (search "Windows" (user-agent) :test 'char-equal) (setq file-name (cl-ppcre:regex-replace ".*\\\\" file-name ""))) (rename-file path (ensure-directories-exist new-path)) (push (list new-path file-name content-type) *tmp-test-files*)))))) @@ -328,7 +328,7 @@ (let* ((path (get-parameter "path")) (file-info (and path (find (pathname path) *tmp-test-files* - :key #'first :test #'equal)))) + :key 'first :test 'equal)))) (unless file-info (setf (return-code *reply*) +http-not-found+) @@ -444,7 +444,7 @@ (:input :type "checkbox" :name "team" :value player - :checked (member player team :test #'string=) + :checked (member player team :test 'string=) (esc player)) (:br))))) (:tr @@ -541,7 +541,7 @@ :defaults *this-file*) "text/plain")) (mapcar (lambda (args) - (apply #'create-prefix-dispatcher args)) + (apply 'create-prefix-dispatcher args)) '(("/hunchentoot/test/form-test.html" form-test) ("/hunchentoot/test/forbidden.html" forbidden) ("/hunchentoot/test/info.html" info) @@ -561,4 +561,4 @@ ("/hunchentoot/test/utf8-string.txt" stream-direct-utf-8-string) ("/hunchentoot/test/files/" send-file) ("/hunchentoot/test" menu))) - (list #'default-dispatcher))) + (list 'default-dispatcher))) From bknr at bknr.net Thu Feb 12 23:30:55 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 13 Feb 2009 00:30:55 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4251 Author: edi URL: http://bknr.net/trac/changeset/4251 Rename U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/packages.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:09:58 UTC (rev 4250) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:30:55 UTC (rev 4251) @@ -50,11 +50,10 @@ used by this acceptor. A function which accepts a REQUEST object and calls a request handler of its choice \(and returns its return value).") - (connection-dispatcher :initarg :connection-dispatcher - :reader acceptor-connection-dispatcher - :documentation "The connection dispatcher that is -responsible for listening to new connections and scheduling them for -execution.") + (taskmaster :initarg :taskmaster + :reader acceptor-taskmaster + :documentation "The taskmaster that is responsible for +scheduling the work for this acceptor.") (output-chunking-p :initarg :output-chunking-p :accessor acceptor-output-chunking-p :documentation "Whether the acceptor may use output chunking.") @@ -124,8 +123,8 @@ :name (gensym) :request-class 'request :handler-selector 'list-handler-selector - :connection-dispatcher (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-dispatcher) - (t 'single-threaded-connection-dispatcher))) + :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-taskmaster) + (t 'single-threaded-taskmaster))) :output-chunking-p t :input-chunking-p t :persistent-connections-p t @@ -157,9 +156,9 @@ in use' or similar).")) (defgeneric accept-connections (acceptor) - (:documentation "In a loop, accepts a connection and -dispatches it to the acceptor's connection dispatcher object for processing -using HANDLE-INCOMING-CONNECTION.")) + (:documentation "In a loop, accepts a connection and dispatches it +to the acceptor's taskmaster for processing using +HANDLE-INCOMING-CONNECTION.")) (defgeneric initialize-connection-stream (acceptor stream) (:documentation "Wraps the given STREAM with all the additional @@ -174,13 +173,12 @@ the stream.")) (defgeneric process-connection (acceptor socket) - (:documentation "This function is called by the connection -dispatcher when a new client connection has been established. -Arguments are the ACCEPTOR object and a usocket socket stream object -\(or a LispWorks socket handle) in SOCKET. It reads the request -headers and hands over to PROCESS-REQUEST. This is done in a loop -until the stream has to be closed or until a connection timeout -occurs.")) + (:documentation "This function is called by the taskmaster when a +new client connection has been established. Arguments are the +ACCEPTOR object and a usocket socket stream object \(or a LispWorks +socket handle) in SOCKET. It reads the request headers and hands over +to PROCESS-REQUEST. This is done in a loop until the stream has to be +closed or until a connection timeout occurs.")) (defgeneric acceptor-ssl-p (acceptor) (:documentation "Returns a true value if ACCEPTOR uses SSL @@ -197,14 +195,14 @@ (defmethod start ((acceptor acceptor)) (start-listening acceptor) - (let ((connection-dispatcher (acceptor-connection-dispatcher acceptor))) - (setf (acceptor connection-dispatcher) acceptor) - (execute-acceptor connection-dispatcher)) + (let ((taskmaster (acceptor-taskmaster acceptor))) + (setf (taskmaster-acceptor taskmaster) acceptor) + (execute-acceptor taskmaster)) acceptor) (defmethod stop ((acceptor acceptor)) (setf (acceptor-shutdown-p acceptor) t) - (shutdown (acceptor-connection-dispatcher acceptor)) + (shutdown (acceptor-taskmaster acceptor)) #-:lispworks (usocket:socket-close (acceptor-listen-socket acceptor))) @@ -228,7 +226,7 @@ (defmethod process-connection :around ((*acceptor* acceptor) (socket t)) "The around method is responsible for error handling." (declare (ignore socket)) - ;; note that this call also binds *ACCEPTOR* + ;; note that this method also binds *ACCEPTOR* (handler-bind ((error ;; abort if there's an error which isn't caught inside (lambda (cond) @@ -299,8 +297,9 @@ (defun process-request (request) "This function is called by PROCESS-CONNECTION after the incoming headers have been read. It sets up the REQUEST and REPLY objects, -dispatches to a handler, and finally sends the output to the client -using START-OUTPUT. If all goes as planned, the function returns T." +selects and calls a handler, and finally sends the output to the +client using START-OUTPUT. If all goes as planned, the function +returns T." (let (*tmp-files* *headers-sent*) (unwind-protect (let* ((*request* request)) @@ -369,7 +368,7 @@ (set-timeouts client-connection (acceptor-read-timeout acceptor) (acceptor-write-timeout acceptor)) - (handle-incoming-connection (acceptor-connection-dispatcher acceptor) + (handle-incoming-connection (acceptor-taskmaster acceptor) client-connection)) ;; ignore condition (usocket:connection-aborted-error ())))))) @@ -395,7 +394,7 @@ :function (lambda (handle) (unless (acceptor-shutdown-p acceptor) (handle-incoming-connection - (acceptor-connection-dispatcher acceptor) handle))) + (acceptor-taskmaster acceptor) handle))) ;; wait until the acceptor was successfully started ;; or an error condition is returned :wait t) Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:09:58 UTC (rev 4250) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:30:55 UTC (rev 4251) @@ -29,84 +29,84 @@ (in-package :hunchentoot) -(defclass connection-dispatcher () - ((acceptor :accessor acceptor +(defclass taskmaster () + ((acceptor :accessor taskmaster-acceptor :documentation "The acceptor instance that this -connection dispatcher works for.")) - (:documentation "Base class for all connection dispatchers classes. -Its purpose is to carry the back pointer to the acceptor instance.")) +taskmaster works for.")) + (:documentation "Base class for all taskmaster classes. Its purpose +is to carry the back pointer to the acceptor instance.")) -(defgeneric execute-acceptor (connection-dispatcher) +(defgeneric execute-acceptor (taskmaster) (:documentation "This function is called once Hunchentoot has performed all initial processing to start listening for incoming connections. It does so by calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from -the ACCEPTOR slot of the connection dispatcher instance. +the ACCEPTOR slot of the taskmaster instance. -In a multi-threaded environment, the connection dispatcher starts a new +In a multi-threaded environment, the taskmaster starts a new thread and calls THUNK in that thread. In a single-threaded environment, the thunk will be called directly.")) -(defgeneric handle-incoming-connection (connection-dispatcher socket) +(defgeneric handle-incoming-connection (taskmaster socket) (:documentation "This function is called by Hunchentoot to start processing of requests on a new incoming connection. SOCKET is the usocket instance that represents the new connection \(or a socket handle on LispWorks). -The connection dispatcher starts processing requests on the incoming +The taskmaster starts processing requests on the incoming connection by calling the START-REQUEST-PROCESSING function of the -acceptor instance, taken from the ACCEPTOR slot in the connection dispatcher +acceptor instance, taken from the ACCEPTOR slot in the taskmaster instance. The SOCKET argument is passed to START-REQUEST-PROCESSING as argument. -In a multi-threaded environment, the connection dispatcher runs this function +In a multi-threaded environment, the taskmaster runs this function in a separate thread. In a single-threaded environment, this function is called directly.")) -(defgeneric shutdown (connection-dispatcher) +(defgeneric shutdown (taskmaster) (:documentation "Terminate all threads that are currently associated -with the connection dispatcher, if any.")) +with the taskmaster, if any.")) -(defclass single-threaded-connection-dispatcher (connection-dispatcher) +(defclass single-threaded-taskmaster (taskmaster) () - (:documentation "Connection Dispatcher that runs synchronously in the + (:documentation "Taskmaster that runs synchronously in the thread that invoked the START-SERVER function.")) -(defmethod execute-acceptor ((dispatcher single-threaded-connection-dispatcher)) - (accept-connections (acceptor dispatcher))) +(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster)) + (accept-connections (taskmaster-acceptor taskmaster))) -(defmethod handle-incoming-connection ((dispatcher single-threaded-connection-dispatcher) socket) - (process-connection (acceptor dispatcher) socket)) +(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket) + (process-connection (taskmaster-acceptor taskmaster) socket)) -(defclass one-thread-per-connection-dispatcher (connection-dispatcher) +(defclass one-thread-per-taskmaster (taskmaster) ((acceptor-process :accessor acceptor-process :documentation "Process that accepts incoming -connections and dispatches them to new processes for request -execution.")) - (:documentation "Connection Dispatcher that starts one thread for +connections and hands them off to new processes for request +handling.")) + (:documentation "Taskmaster that starts one thread for listening to incoming requests and one thread for each incoming connection.")) ;; usocket implementation #-:lispworks -(defmethod shutdown ((dispatcher connection-dispatcher))) +(defmethod shutdown ((taskmaster taskmaster))) #-:lispworks -(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) +(defmethod shutdown ((taskmaster one-thread-per-taskmaster)) ;; just wait until the acceptor process has finished, then return (loop - (unless (bt:thread-alive-p (acceptor-process dispatcher)) + (unless (bt:thread-alive-p (acceptor-process taskmaster)) (return)) (sleep 1))) #-:lispworks -(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) - (setf (acceptor-process dispatcher) +(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) + (setf (acceptor-process taskmaster) (bt:make-thread (lambda () - (accept-connections (acceptor dispatcher))) + (accept-connections (taskmaster-acceptor taskmaster))) :name (format nil "Hunchentoot acceptor \(~A:~A)" - (or (acceptor-address (acceptor dispatcher)) "*") - (acceptor-port (acceptor dispatcher)))))) + (or (acceptor-address (taskmaster-acceptor taskmaster)) "*") + (acceptor-port (taskmaster-acceptor taskmaster)))))) #-:lispworks (defun client-as-string (socket) @@ -118,26 +118,26 @@ port)))) #-:lispworks -(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) +(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket) (bt:make-thread (lambda () - (process-connection (acceptor dispatcher) socket)) + (process-connection (taskmaster-acceptor taskmaster) socket)) :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) ;; LispWorks implementation #+:lispworks -(defmethod shutdown ((dispatcher connection-dispatcher)) - (when-let (process (acceptor-process (acceptor dispatcher))) +(defmethod shutdown ((taskmaster taskmaster)) + (when-let (process (acceptor-process (taskmaster-acceptor taskmaster))) ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER (mp:process-kill process))) #+:lispworks -(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) - (accept-connections (acceptor dispatcher))) +(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) + (accept-connections (taskmaster-acceptor taskmaster))) #+:lispworks -(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) +(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* @@ -148,4 +148,4 @@ (multiple-value-list (get-peer-address-and-port handle))) nil #'process-connection - (acceptor dispatcher) handle)) + (taskmaster-acceptor taskmaster) handle)) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:09:58 UTC (rev 4250) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:30:55 UTC (rev 4251) @@ -117,7 +117,6 @@ "+HTTP-USE-PROXY+" "+HTTP-VERSION-NOT-SUPPORTED+" "ABORT-REQUEST-HANDLER" - "ACCEPTOR" "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" "ACCEPTOR-HANDLER-SELECTOR" @@ -150,7 +149,6 @@ "COOKIES-IN" "COOKIES-IN*" "COOKIES-OUT" - "CONNECTION-DISPATCHER" "CREATE-FOLDER-DISPATCHER-AND-HANDLER" "CREATE-PREFIX-DISPATCHER" "CREATE-REGEX-DISPATCHER" @@ -239,6 +237,8 @@ "START-LISTENING" "START-SESSION" "STOP" + "TASKMASTER" + "TASKMASTER-ACCEPTOR" "URL-DECODE" "URL-ENCODE" "USER-AGENT")) From bknr at bknr.net Thu Feb 12 23:31:38 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 13 Feb 2009 00:31:38 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4252 Author: edi URL: http://bknr.net/trac/changeset/4252 Rename file as well D trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/hunchentoot.asd A trunk/thirdparty/hunchentoot/taskmaster.lisp Deleted: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:30:55 UTC (rev 4251) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:31:38 UTC (rev 4252) @@ -1,151 +0,0 @@ -;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- -;;; $Header$ - -;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. - -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: - -;;; * Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. - -;;; * Redistributions in binary form must reproduce the above -;;; copyright notice, this list of conditions and the following -;;; disclaimer in the documentation and/or other materials -;;; provided with the distribution. - -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED -;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -(in-package :hunchentoot) - -(defclass taskmaster () - ((acceptor :accessor taskmaster-acceptor - :documentation "The acceptor instance that this -taskmaster works for.")) - (:documentation "Base class for all taskmaster classes. Its purpose -is to carry the back pointer to the acceptor instance.")) - -(defgeneric execute-acceptor (taskmaster) - (:documentation - "This function is called once Hunchentoot has performed all initial -processing to start listening for incoming connections. It does so by -calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from -the ACCEPTOR slot of the taskmaster instance. - -In a multi-threaded environment, the taskmaster starts a new -thread and calls THUNK in that thread. In a single-threaded -environment, the thunk will be called directly.")) - -(defgeneric handle-incoming-connection (taskmaster socket) - (:documentation - "This function is called by Hunchentoot to start processing of -requests on a new incoming connection. SOCKET is the usocket instance -that represents the new connection \(or a socket handle on LispWorks). -The taskmaster starts processing requests on the incoming -connection by calling the START-REQUEST-PROCESSING function of the -acceptor instance, taken from the ACCEPTOR slot in the taskmaster -instance. The SOCKET argument is passed to START-REQUEST-PROCESSING -as argument. - -In a multi-threaded environment, the taskmaster runs this function -in a separate thread. In a single-threaded environment, this function -is called directly.")) - -(defgeneric shutdown (taskmaster) - (:documentation "Terminate all threads that are currently associated -with the taskmaster, if any.")) - -(defclass single-threaded-taskmaster (taskmaster) - () - (:documentation "Taskmaster that runs synchronously in the -thread that invoked the START-SERVER function.")) - -(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster)) - (accept-connections (taskmaster-acceptor taskmaster))) - -(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket) - (process-connection (taskmaster-acceptor taskmaster) socket)) - -(defclass one-thread-per-taskmaster (taskmaster) - ((acceptor-process :accessor acceptor-process - :documentation "Process that accepts incoming -connections and hands them off to new processes for request -handling.")) - (:documentation "Taskmaster that starts one thread for -listening to incoming requests and one thread for each incoming -connection.")) - -;; usocket implementation - -#-:lispworks -(defmethod shutdown ((taskmaster taskmaster))) - -#-:lispworks -(defmethod shutdown ((taskmaster one-thread-per-taskmaster)) - ;; just wait until the acceptor process has finished, then return - (loop - (unless (bt:thread-alive-p (acceptor-process taskmaster)) - (return)) - (sleep 1))) - -#-:lispworks -(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) - (setf (acceptor-process taskmaster) - (bt:make-thread (lambda () - (accept-connections (taskmaster-acceptor taskmaster))) - :name (format nil "Hunchentoot acceptor \(~A:~A)" - (or (acceptor-address (taskmaster-acceptor taskmaster)) "*") - (acceptor-port (taskmaster-acceptor taskmaster)))))) - -#-:lispworks -(defun client-as-string (socket) - (let ((address (usocket:get-peer-address socket)) - (port (usocket:get-peer-port socket))) - (when (and address port) - (format nil "~A:~A" - (usocket:vector-quad-to-dotted-quad address) - port)))) - -#-:lispworks -(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket) - (bt:make-thread (lambda () - (process-connection (taskmaster-acceptor taskmaster) socket)) - :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) - -;; LispWorks implementation - -#+:lispworks -(defmethod shutdown ((taskmaster taskmaster)) - (when-let (process (acceptor-process (taskmaster-acceptor taskmaster))) - ;; kill the main acceptor process, see LW documentation for - ;; COMM:START-UP-SERVER - (mp:process-kill process))) - -#+:lispworks -(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) - (accept-connections (taskmaster-acceptor taskmaster))) - -#+:lispworks -(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle) - (incf *worker-counter*) - ;; check if we need to perform a global GC - (when (and *cleanup-interval* - (zerop (mod *worker-counter* *cleanup-interval*))) - (when *cleanup-function* - (funcall *cleanup-function*))) - (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})" - (multiple-value-list - (get-peer-address-and-port handle))) - nil #'process-connection - (taskmaster-acceptor taskmaster) handle)) Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd =================================================================== --- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 23:30:55 UTC (rev 4251) +++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 23:31:38 UTC (rev 4252) @@ -76,6 +76,6 @@ (:file "easy-handlers") (:file "headers") (:file "set-timeouts") - (:file "connection-dispatcher") + (:file "taskmaster") (:file "acceptor") #-:hunchentoot-no-ssl (:file "ssl"))) Copied: trunk/thirdparty/hunchentoot/taskmaster.lisp (from rev 4251, trunk/thirdparty/hunchentoot/connection-dispatcher.lisp) =================================================================== --- trunk/thirdparty/hunchentoot/taskmaster.lisp (rev 0) +++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-12 23:31:38 UTC (rev 4252) @@ -0,0 +1,151 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- +;;; $Header$ + +;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :hunchentoot) + +(defclass taskmaster () + ((acceptor :accessor taskmaster-acceptor + :documentation "The acceptor instance that this +taskmaster works for.")) + (:documentation "Base class for all taskmaster classes. Its purpose +is to carry the back pointer to the acceptor instance.")) + +(defgeneric execute-acceptor (taskmaster) + (:documentation + "This function is called once Hunchentoot has performed all initial +processing to start listening for incoming connections. It does so by +calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from +the ACCEPTOR slot of the taskmaster instance. + +In a multi-threaded environment, the taskmaster starts a new +thread and calls THUNK in that thread. In a single-threaded +environment, the thunk will be called directly.")) + +(defgeneric handle-incoming-connection (taskmaster socket) + (:documentation + "This function is called by Hunchentoot to start processing of +requests on a new incoming connection. SOCKET is the usocket instance +that represents the new connection \(or a socket handle on LispWorks). +The taskmaster starts processing requests on the incoming +connection by calling the START-REQUEST-PROCESSING function of the +acceptor instance, taken from the ACCEPTOR slot in the taskmaster +instance. The SOCKET argument is passed to START-REQUEST-PROCESSING +as argument. + +In a multi-threaded environment, the taskmaster runs this function +in a separate thread. In a single-threaded environment, this function +is called directly.")) + +(defgeneric shutdown (taskmaster) + (:documentation "Terminate all threads that are currently associated +with the taskmaster, if any.")) + +(defclass single-threaded-taskmaster (taskmaster) + () + (:documentation "Taskmaster that runs synchronously in the +thread that invoked the START-SERVER function.")) + +(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster)) + (accept-connections (taskmaster-acceptor taskmaster))) + +(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket) + (process-connection (taskmaster-acceptor taskmaster) socket)) + +(defclass one-thread-per-taskmaster (taskmaster) + ((acceptor-process :accessor acceptor-process + :documentation "Process that accepts incoming +connections and hands them off to new processes for request +handling.")) + (:documentation "Taskmaster that starts one thread for +listening to incoming requests and one thread for each incoming +connection.")) + +;; usocket implementation + +#-:lispworks +(defmethod shutdown ((taskmaster taskmaster))) + +#-:lispworks +(defmethod shutdown ((taskmaster one-thread-per-taskmaster)) + ;; just wait until the acceptor process has finished, then return + (loop + (unless (bt:thread-alive-p (acceptor-process taskmaster)) + (return)) + (sleep 1))) + +#-:lispworks +(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) + (setf (acceptor-process taskmaster) + (bt:make-thread (lambda () + (accept-connections (taskmaster-acceptor taskmaster))) + :name (format nil "Hunchentoot acceptor \(~A:~A)" + (or (acceptor-address (taskmaster-acceptor taskmaster)) "*") + (acceptor-port (taskmaster-acceptor taskmaster)))))) + +#-:lispworks +(defun client-as-string (socket) + (let ((address (usocket:get-peer-address socket)) + (port (usocket:get-peer-port socket))) + (when (and address port) + (format nil "~A:~A" + (usocket:vector-quad-to-dotted-quad address) + port)))) + +#-:lispworks +(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket) + (bt:make-thread (lambda () + (process-connection (taskmaster-acceptor taskmaster) socket)) + :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) + +;; LispWorks implementation + +#+:lispworks +(defmethod shutdown ((taskmaster taskmaster)) + (when-let (process (acceptor-process (taskmaster-acceptor taskmaster))) + ;; kill the main acceptor process, see LW documentation for + ;; COMM:START-UP-SERVER + (mp:process-kill process))) + +#+:lispworks +(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) + (accept-connections (taskmaster-acceptor taskmaster))) + +#+:lispworks +(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle) + (incf *worker-counter*) + ;; check if we need to perform a global GC + (when (and *cleanup-interval* + (zerop (mod *worker-counter* *cleanup-interval*))) + (when *cleanup-function* + (funcall *cleanup-function*))) + (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})" + (multiple-value-list + (get-peer-address-and-port handle))) + nil #'process-connection + (taskmaster-acceptor taskmaster) handle)) From bknr at bknr.net Thu Feb 12 23:36:48 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 13 Feb 2009 00:36:48 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/packages.lisp Message-ID: Revision: 4253 Author: edi URL: http://bknr.net/trac/changeset/4253 Compiles, runs, passes tests on LW U trunk/thirdparty/hunchentoot/packages.lisp Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:31:38 UTC (rev 4252) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:36:48 UTC (rev 4253) @@ -117,6 +117,7 @@ "+HTTP-USE-PROXY+" "+HTTP-VERSION-NOT-SUPPORTED+" "ABORT-REQUEST-HANDLER" + "ACCEPTOR" "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" "ACCEPTOR-HANDLER-SELECTOR" From bknr at bknr.net Thu Feb 12 23:38:00 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 13 Feb 2009 00:38:00 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/acceptor.lisp Message-ID: Revision: 4254 Author: edi URL: http://bknr.net/trac/changeset/4254 Indentation U trunk/thirdparty/hunchentoot/acceptor.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:36:48 UTC (rev 4253) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:38:00 UTC (rev 4254) @@ -124,7 +124,7 @@ :request-class 'request :handler-selector 'list-handler-selector :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-taskmaster) - (t 'single-threaded-taskmaster))) + (t 'single-threaded-taskmaster))) :output-chunking-p t :input-chunking-p t :persistent-connections-p t From bknr at bknr.net Mon Feb 16 12:00:16 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 13:00:16 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4255 Author: hans URL: http://bknr.net/trac/changeset/4255 add some documentation on the testing facility U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/test/script-engine.lisp U trunk/thirdparty/hunchentoot/test/script.lisp Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-12 23:38:00 UTC (rev 4254) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-16 12:00:15 UTC (rev 4255) @@ -2592,12 +2592,51 @@ using RAW-POST-DATA instead of reading the request body using a flexi stream. Usually, this is automatically done right by Hunchentoot to read POST data, and - you should only use the want-stream keyword argument to the - RAW-POST-DATA in rare circumstances. + you should only use the want-stream + keyword argument to the RAW-POST-DATA in + rare circumstances.
    + + Hunchentoot comes with a test script that verifies that the + example web server responds as expected. This test script uses the + Drakma HTTP client library + and thus shares a significant amount of its base code with + Hunchentoot itself. Still, running the test script is a useful + confidence test, and it is also possible to run the script across + machines in order to verify a new Hunchentoot (or, for that matter + Drakma) port. +

    + To run the confidence test, start + the example web server. Then, in your Lisp + listener, type +

    (hunchentoot-test:test-hunchentoot "http://localhost:4242")
    + You will see some diagnostic output and a summary line that + reports whether any tests have failed. +

    + + + base-url key + | + + Run the built-in confidence + test. base-url is the base URL to use + for testing, it should not have a trailing slash. The keyword + arguments accepted are for future extension and should not + currently be used. +

    + The script expects the Hunchentoot example test server to be + running at the given base-url and + retrieves various pages from that server, expecting certain + responses. +

    +     +     + +     + Hunchentoot's predecessor TBNL Modified: trunk/thirdparty/hunchentoot/test/script-engine.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-12 23:38:00 UTC (rev 4254) +++ trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-16 12:00:15 UTC (rev 4255) @@ -47,13 +47,21 @@ (defvar *script-context* nil "Current script context") -(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys) &body body) +(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys) + &body body) `(let ((*script-context* (make-instance ',context-class-name , at args)) - (*default-pathname-defaults* *this-file*)) + (*default-pathname-defaults* *this-file*) + failed) (handler-bind ((assertion-failed (lambda (condition) + (push condition failed) (format t "Assertion failed:~%~A~%" condition)))) - (progn , at body)))) + (prog1 + (progn , at body + (values)) + (if failed + (format t ";; ~A assertion~:P FAILED~%" (length failed)) + (format t ";; all tests PASSED~%")))))) (defclass http-reply () ((body :initarg :body) Modified: trunk/thirdparty/hunchentoot/test/script.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-12 23:38:00 UTC (rev 4254) +++ trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-16 12:00:15 UTC (rev 4255) @@ -33,21 +33,30 @@ (with-open-file (f pathname) (princ-to-string (file-length f)))) +(defun say (fmt &rest args) + (format t "; ") + (apply #'format t fmt args) + (terpri)) + (defun test-hunchentoot (base-url &key (make-cookie-jar (lambda () (make-instance 'drakma:cookie-jar)))) + + "Run the built-in confidence test. The keyword arguments accepted + are for future extension and should not currently be used." + (with-script-context (:base-url (format nil "~A/hunchentoot/test/" base-url)) - (format t "Request home page~%") + (say "Request home page") (http-request "") (http-assert 'status-code 200) (http-assert-header :content-type "^text/html") - (format t "Test cookies~%") + (say "Test cookies") (let ((cookie-jar (funcall make-cookie-jar))) (http-request "cookie.html" :cookie-jar cookie-jar) (http-request "cookie.html" :cookie-jar cookie-jar) (http-assert-body "(?ms)COOKIE-IN "pumpkin".*"barking"")) - (format t "Test session variables~%") + (say "Test session variables") (let ((cookie-jar (funcall make-cookie-jar))) (http-request "session.html" :cookie-jar cookie-jar :method :post :parameters '(("new-foo-value" . "ABC") ("new-bar-value" . "DEF"))) @@ -56,26 +65,26 @@ (http-assert-body "\(HUNCHENTOOT-TEST::FOO . "ABC"\)") (http-assert-body "\(HUNCHENTOOT-TEST::BAR . "DEF"\)")) - (format t "Test GET parameters with foreign characters (Latin-1)~%") + (say "Test GET parameters with foreign characters (Latin-1)") (http-request "parameter_latin1_get.html?foo=H%FChner") (http-assert-header :content-type "text/html; charset=ISO-8859-1") (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") - (format t "Test POST parameters with foreign characters (Latin-1)~%") + (say "Test POST parameters with foreign characters (Latin-1)") (http-request "parameter_latin1_post.html" :method :post :parameters (list (cons "foo" (format nil "H~Chner" #.(code-char 252))))) (http-assert-header :content-type "text/html; charset=ISO-8859-1") (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") - (format t "Test GET parameters with foreign characters (UTF-8)~%") + (say "Test GET parameters with foreign characters (UTF-8)") (http-request "parameter_utf8_get.html?foo=H%C3%BChner") (http-assert-header :content-type "text/html; charset=UTF-8") (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") - (format t "Test POST parameters with foreign characters (UTF-8)~%") + (say "Test POST parameters with foreign characters (UTF-8)") (http-request "parameter_utf8_post.html" :method :post :external-format-out :utf-8 @@ -84,31 +93,31 @@ (http-assert-body "(72 252 104 110 101 114)") (http-assert-body ""Hühner"") - (format t "Test redirection~%") + (say "Test redirection") (http-request "redir.html") (http-assert 'uri (lambda (uri) (matches (princ-to-string uri) "info.html\\?redirected=1"))) - (format t "Test authorization~%") + (say "Test authorization") (http-request "authorization.html") (http-assert 'status-code 401) (http-request "authorization.html" :basic-authorization '("nanook" "igloo")) (http-assert 'status-code 200) - (format t "Request the Zappa image~%") + (say "Request the Zappa image") (http-request "image.jpg") (http-assert-header :content-length (file-length-string #P"fz.jpg")) (http-assert-header :content-type "image/jpeg") (http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg")) - (format t "Request the Zappa image from RAM~%") + (say "Request the Zappa image from RAM") (http-request "image-ram.jpg") (http-assert-header :content-length (file-length-string #P"fz.jpg")) (http-assert-header :content-type "image/jpeg") (http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg")) - (format t "Upload a file~%") + (say "Upload a file") (http-request "upload.html" :method :post :parameters '(("clean" . "doit"))) (http-request "upload.html" From bknr at bknr.net Mon Feb 16 12:05:37 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 13:05:37 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/test/script.lisp Message-ID: Revision: 4256 Author: hans URL: http://bknr.net/trac/changeset/4256 Forgot to save this. U trunk/thirdparty/hunchentoot/test/script.lisp Modified: trunk/thirdparty/hunchentoot/test/script.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-16 12:00:15 UTC (rev 4255) +++ trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-16 12:05:37 UTC (rev 4256) @@ -40,9 +40,15 @@ (defun test-hunchentoot (base-url &key (make-cookie-jar (lambda () (make-instance 'drakma:cookie-jar)))) - "Run the built-in confidence test. The keyword arguments accepted - are for future extension and should not currently be used." + "Run the built-in confidence test. BASE-URL is the base URL to use + for testing, it should not have a trailing slash. The keyword + arguments accepted are for future extension and should not + currently be used. + The script expects the Hunchentoot example test server to be + running at the given BASE-URL and retrieves various pages from that + server, expecting certain responses." + (with-script-context (:base-url (format nil "~A/hunchentoot/test/" base-url)) (say "Request home page") From bknr at bknr.net Mon Feb 16 14:18:15 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 15:18:15 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4257 Author: edi URL: http://bknr.net/trac/changeset/4257 Some fixes U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/ssl.lisp U trunk/thirdparty/hunchentoot/taskmaster.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 12:05:37 UTC (rev 4256) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 14:18:15 UTC (rev 4257) @@ -123,7 +123,7 @@ :name (gensym) :request-class 'request :handler-selector 'list-handler-selector - :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-taskmaster) + :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-taskmaster) (t 'single-threaded-taskmaster))) :output-chunking-p t :input-chunking-p t @@ -206,12 +206,12 @@ #-:lispworks (usocket:socket-close (acceptor-listen-socket acceptor))) -(defmethod initialize-connection-stream (acceptor stream) +(defmethod initialize-connection-stream ((acceptor acceptor) stream) (declare (ignore acceptor)) ;; default method does nothing stream) -(defmethod reset-connection-stream (acceptor stream) +(defmethod reset-connection-stream ((acceptor acceptor) stream) (declare (ignore acceptor)) ;; turn chunking off at this point (cond ((typep stream 'chunked-stream) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-16 12:05:37 UTC (rev 4256) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-16 14:18:15 UTC (rev 4257) @@ -182,6 +182,7 @@ "MIME-TYPE" "NEXT-SESSION-ID" "NO-CACHE" + "ONE-THREAD-PER-CONNECTION-TASKMASTER" "PARAMETER" "POST-PARAMETER" "POST-PARAMETERS" @@ -232,6 +233,7 @@ "SET-COOKIE" "SET-COOKIE*" "SHUTDOWN" + "SINGLE-THREADED-TASKMASTER" "SSL-ACCEPTOR" "SSL-P" "START" Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 12:05:37 UTC (rev 4256) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 14:18:15 UTC (rev 4257) @@ -104,4 +104,4 @@ (make-ssl-server-stream stream :certificate-file (acceptor-ssl-certificate-file acceptor) :privatekey-file (acceptor-ssl-privatekey-file acceptor) - :privatekey-password (acceptor-ssl-privatekey-password acceptor)))) \ No newline at end of file + :privatekey-password (acceptor-ssl-privatekey-password acceptor)))) Modified: trunk/thirdparty/hunchentoot/taskmaster.lisp =================================================================== --- trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 12:05:37 UTC (rev 4256) +++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 14:18:15 UTC (rev 4257) @@ -77,7 +77,7 @@ (defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket) (process-connection (taskmaster-acceptor taskmaster) socket)) -(defclass one-thread-per-taskmaster (taskmaster) +(defclass one-thread-per-connection-taskmaster (taskmaster) ((acceptor-process :accessor acceptor-process :documentation "Process that accepts incoming connections and hands them off to new processes for request @@ -92,7 +92,7 @@ (defmethod shutdown ((taskmaster taskmaster))) #-:lispworks -(defmethod shutdown ((taskmaster one-thread-per-taskmaster)) +(defmethod shutdown ((taskmaster one-thread-per-connection-taskmaster)) ;; just wait until the acceptor process has finished, then return (loop (unless (bt:thread-alive-p (acceptor-process taskmaster)) @@ -100,7 +100,7 @@ (sleep 1))) #-:lispworks -(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) +(defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster)) (setf (acceptor-process taskmaster) (bt:make-thread (lambda () (accept-connections (taskmaster-acceptor taskmaster))) @@ -118,7 +118,7 @@ port)))) #-:lispworks -(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket) +(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket) (bt:make-thread (lambda () (process-connection (taskmaster-acceptor taskmaster) socket)) :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) @@ -133,11 +133,11 @@ (mp:process-kill process))) #+:lispworks -(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster)) +(defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster)) (accept-connections (taskmaster-acceptor taskmaster))) #+:lispworks -(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle) +(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* From bknr at bknr.net Mon Feb 16 20:17:51 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 21:17:51 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4258 Author: edi URL: http://bknr.net/trac/changeset/4258 Fix SSL problems (for LispWorks) U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/ssl.lisp A trunk/thirdparty/hunchentoot/test/test-certificate.crt A trunk/thirdparty/hunchentoot/test/test-key-no-password.key Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 14:18:15 UTC (rev 4257) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 20:17:51 UTC (rev 4258) @@ -243,6 +243,7 @@ (defmethod process-connection ((*acceptor* acceptor) (socket t)) (let ((*hunchentoot-stream* (initialize-connection-stream *acceptor* (make-socket-stream socket *acceptor*)))) + (print *hunchentoot-stream*) (unwind-protect ;; process requests until either the acceptor is shut down, ;; *CLOSE-HUNCHENTOOT-STREAM* has been set to T by the Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 14:18:15 UTC (rev 4257) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 20:17:51 UTC (rev 4258) @@ -32,22 +32,21 @@ (defclass ssl-acceptor (acceptor) ((ssl-certificate-file :initarg :ssl-certificate-file :reader acceptor-ssl-certificate-file - :documentation "The namestring of a -certificate file.") + :documentation "A pathname designator for a +certificate file in PEM format.") (ssl-privatekey-file :initarg :ssl-privatekey-file :reader acceptor-ssl-privatekey-file - :documentation "The namestring of a private -key file, or NIL if the certificate file contains the private key.") - (ssl-privatekey-password #+:lispworks #+:lispworks - :initform nil + :documentation "A pathname designator for a +private key file in PEM format, or \(only on LispWorks) NIL if the +certificate file contains the private key.") + #+:lispworks + (ssl-privatekey-password :initform nil :initarg :ssl-privatekey-password :reader acceptor-ssl-privatekey-password :documentation "The password for the -private key file or NIL.")) +private key file or NIL for no password.")) (:default-initargs - :port 443 - :input-chunking-p nil - :output-chunking-p nil) + :port 443) (:documentation "This class defines additional slots required to serve requests via SSL.")) @@ -56,6 +55,19 @@ (defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) t) +(defmethod initialize-instance :after ((acceptor ssl-acceptor) &rest initargs) + (declare (ignore initargs)) + ;; LispWorks can read both from the same file, so we can default one + #+:lispworks + (unless (slot-boundp acceptor 'ssl-privatekey-file) + (setf (slot-value acceptor 'ssl-privatekey-file) + (acceptor-ssl-certificate-file acceptor))) + ;; OpenSSL doesn't know much about Lisp pathnames... + (setf (slot-value acceptor 'ssl-privatekey-file) + (namestring (truename (acceptor-ssl-privatekey-file acceptor))) + (slot-value acceptor 'ssl-certificate-file) + (namestring (truename (acceptor-ssl-certificate-file acceptor))))) + ;; usocket implementation #-:lispworks @@ -68,14 +80,6 @@ ;; LispWorks implementation -#+:lispworks -(defmethod initialize-instance :after ((acceptor ssl-acceptor) &rest initargs) - (declare (ignore initargs)) - ;; LispWorks can read both from the same file, so we can default one - (unless (slot-boundp acceptor 'ssl-privatekey-file) - (setf (slot-value acceptor 'ssl-privatekey-file) - (acceptor-ssl-certificate-file acceptor)))) - #+lispworks (defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the Added: trunk/thirdparty/hunchentoot/test/test-certificate.crt =================================================================== --- trunk/thirdparty/hunchentoot/test/test-certificate.crt (rev 0) +++ trunk/thirdparty/hunchentoot/test/test-certificate.crt 2009-02-16 20:17:51 UTC (rev 4258) @@ -0,0 +1,13 @@ +-----BEGIN CERTIFICATE----- +MIIB3TCCAUYCCQCDg/PAAhv7kjANBgkqhkiG9w0BAQQFADAzMQswCQYDVQQGEwJE +RTEQMA4GA1UECBMHR2VybWFueTESMBAGA1UEAxMJbG9jYWxob3N0MB4XDTA5MDIx +NjEyMTgzMFoXDTEwMDIxNjEyMTgzMFowMzELMAkGA1UEBhMCREUxEDAOBgNVBAgT +B0dlcm1hbnkxEjAQBgNVBAMTCWxvY2FsaG9zdDCBnzANBgkqhkiG9w0BAQEFAAOB +jQAwgYkCgYEAxpUaQISfEDw3c7VSFsW+oKQViarjMmZNJL7ZWaZlsbVgROPohCRj +qmbS1yjQ0DZQWZK4PMyyXqT90OUIXSohGAB9O3M/etMpMYaRlws66o2mNx/R8bTZ +qGDQcXXRg1Ghsq2JnQsyhl4nTQXMn8KM/jLd6iT9XJd+O6AuWfOlticCAwEAATAN +BgkqhkiG9w0BAQQFAAOBgQCUW7a5BvL8Qoy5Mvd9cxUt8jnDm5KRiEgcmBIIlrVi +bLXmEQaRPQDoxGsrzi/LaUuMitT/kaGwhbdhfwZsjXI2QxuqpPYRhLnPBvn6q77u +e0/yXaPp6UnMnQNw2O8xLcUDeLbRrw9IBPeDUYYP0OaTkJvORwFJ4e6rdVyha4o7 +1A== +-----END CERTIFICATE----- Added: trunk/thirdparty/hunchentoot/test/test-key-no-password.key =================================================================== --- trunk/thirdparty/hunchentoot/test/test-key-no-password.key (rev 0) +++ trunk/thirdparty/hunchentoot/test/test-key-no-password.key 2009-02-16 20:17:51 UTC (rev 4258) @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICWwIBAAKBgQDGlRpAhJ8QPDdztVIWxb6gpBWJquMyZk0kvtlZpmWxtWBE4+iE +JGOqZtLXKNDQNlBZkrg8zLJepP3Q5QhdKiEYAH07cz960ykxhpGXCzrqjaY3H9Hx +tNmoYNBxddGDUaGyrYmdCzKGXidNBcyfwoz+Mt3qJP1cl347oC5Z86W2JwIDAQAB +AoGAJoJhneNaCUb0Je8ipSHhzrsjJhhKiMqH6TlNYvI+xFB9A78CpyV7Yl8gQfM7 +UzVFLamjKr8zU+FBC1Ju5co2sl4u3fPgXwuo5X36IVa03WdClXp0PQ7RsOXqi0Rx +d1maRkxPok7AnSMCAWNeLCgxVmCKzIWLKcvB8idK7evjGUkCQQDyoewf7ey1eNy7 +hv87E9E/gUQ/9A9rEhkKcRbwvEicB+OcxpZl6Br0Z6EJH39AlJe1ii81lSqfPd+h +6WE2uU+lAkEA0YXmYnCJdlcYAORLX3ewibVCikOJUIMt7smGVOK23ubmHh49+KUW +HT3xDPDRVmkmiYzqXZOY0pGUG37b4GAE2wJAXRPa1kDanp835kSaYtpuWjNHsFT7 +GTL/Ii9SApXoMNsh6QGRrpREyt96Olq34VlffYf+JksL57y/rogt/+VE9QJAV+vV +YmeQ92zSsMUb7+K83PyIAJcYjwWNB8/fI83DKURBOlA8dxNndTvh5ClF3vne5weP +7VabYXkfam5QfBYu0wJANPeIsAd8yUdZViiMOH6tE8DUlMy/p1N9Rz0eMSc4uUch +EB59djdHmSknY0JgVZJFybWFWKtbxSvcnrJq/hAcMQ== +-----END RSA PRIVATE KEY----- From bknr at bknr.net Mon Feb 16 21:24:05 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 22:24:05 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4259 Author: edi URL: http://bknr.net/trac/changeset/4259 Add documentation U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/ssl.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 20:17:51 UTC (rev 4258) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 21:24:05 UTC (rev 4259) @@ -32,65 +32,87 @@ (defclass acceptor () ((port :initarg :port :reader acceptor-port - :documentation "The port the acceptor is listening on.") + :documentation "The port the acceptor is listening on. The +default is 80. Note that depending on your operating system you might +need special privileges to listen on port 80.") (address :initarg :address :reader acceptor-address - :documentation "The address the acceptor is listening on.") + :documentation "The address the acceptor is listening on. +If address is a string denoting an IP address, then the server only +receives connections for that address. This must be one of the +addresses associated with the machine and allowed values are host +names such as \"www.zappa.com\" and address strings such as +\"72.3.247.29\". If address is NIL, then the server will receive +connections to all IP addresses on the machine. This is the default.") (name :initarg :name :accessor acceptor-name - :documentation "The optional name of the acceptor, a symbol.") + :documentation "The optional name of the acceptor, a symbol. +This name can be utilized when defining \"easy handlers\" - see +DEFINE-EASY-HANDLER. The default name is an uninterned symbol as +returned by GENSYM.") (request-class :initarg :request-class :accessor acceptor-request-class :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol -naming) a class which inherits from REQUEST.") +naming) a class which inherits from REQUEST. The default is the +symbol REQUEST.") (handler-selector :initarg :handler-selector :accessor acceptor-handler-selector - :documentation "The handler selector function -used by this acceptor. A function which accepts a REQUEST object and -calls a request handler of its choice \(and returns its return -value).") + :documentation "A designator for the handler +selector function used by this acceptor. A function which accepts a +REQUEST object and calls a request handler of its choice \(and returns +its return value). The default is the unexported symbol +LIST-HANDLER-SELECTOR which works through the list *DISPATCH-TABLE*.") (taskmaster :initarg :taskmaster :reader acceptor-taskmaster - :documentation "The taskmaster that is responsible for -scheduling the work for this acceptor.") + :documentation "The taskmaster \(i.e. an instance of a +subclass of TASKMASTER) that is responsible for scheduling the work +for this acceptor. The default depends on the MP capabilities of the +underlying Lisp.") (output-chunking-p :initarg :output-chunking-p :accessor acceptor-output-chunking-p - :documentation "Whether the acceptor may use output chunking.") + :documentation "A generalized boolean denoting +whether the acceptor may use chunked encoding for output, i.e. when +sending data to the client. The default is T and there's usually no +reason to change this to NIL.") (input-chunking-p :initarg :input-chunking-p :accessor acceptor-input-chunking-p - :documentation "Whether the acceptor may use input chunking.") + :documentation "A generalized boolean denoting +whether the acceptor may use chunked encoding for input, i.e. when +accepting request bodies from the client. The default is T and +there's usually no reason to change this to NIL.") (persistent-connections-p :initarg :persistent-connections-p :accessor acceptor-persistent-connections-p - :documentation "Whether the acceptor -supports persistent connections, which is the default for threaded -acceptors. If this property is false, Hunchentoot closes incoming -connections after having processed one request. This is the default -for non-threaded acceptors.") + :documentation "A generalized boolean +denoting whether the acceptor supports persistent connections, which +is the default for threaded acceptors. If this property is NIL, +Hunchentoot closes each incoming connection after having processed one +request. This is the default for non-threaded acceptors.") (read-timeout :initarg :read-timeout :reader acceptor-read-timeout - :documentation "The connection timeout of the -acceptor, specified in \(fractional) seconds. Connections that are -idle for longer than this time are closed by Hunchentoot. The precise -semantics of this parameter is determined by the underlying Lisp's -implementation of socket timeouts. NIL means no timeout.") + :documentation "The read timeout of the acceptor, +specified in \(fractional) seconds. The precise semantics of this +parameter is determined by the underlying Lisp's implementation of +socket timeouts. NIL \(which is the default that you might want to +change for production environments) means no timeout.") (write-timeout :initarg :write-timeout :reader acceptor-write-timeout - :documentation "The connection timeout of the -acceptor, specified in \(fractional) seconds. The precise semantics -of this parameter is determined by the underlying Lisp's -implementation of socket timeouts. NIL means no timeout.") + :documentation "The write timeout of the acceptor, +specified in \(fractional) seconds. The precise semantics of this +parameter is determined by the underlying Lisp's implementation of +socket timeouts. NIL \(which is the default that you might want to +change for production environments) means no timeout.") #+:lispworks (process :accessor acceptor-process :documentation "The Lisp process which accepts incoming requests.") #-:lispworks (listen-socket :accessor acceptor-listen-socket - :documentation "The listen socket for incoming - connections.") + :documentation "The socket listening for incoming +connections.") (acceptor-shutdown-p :initform nil :accessor acceptor-shutdown-p - :documentation "Flag that makes the acceptor + :documentation "A flag that makes the acceptor shutdown itself when set to something other than NIL.") (access-logger :initarg :access-logger :accessor acceptor-access-logger @@ -132,9 +154,17 @@ :write-timeout nil :access-logger 'log-access-to-file :message-logger 'log-message-to-file) - (:documentation "An object of this class contains all relevant -information about a running Hunchentoot acceptor instance.")) + (:documentation "To create a Hunchentoot webserver, you make an +instance of this class and use the generic function START to start it +\(and STOP to stop it). Use the :PORT initarg if you don't want to +listen on the default http port 80. There are other initargs most of +which you probably won't need very often. They are explained in +detail in the docstrings of the slot definitions for this class. +Unless you are in a Lisp without MP capabilities, you can have several +active instances of ACCEPTOR \(listening on different ports) at the +same time.")) + (defmethod print-object ((acceptor acceptor) stream) (print-unreadable-object (acceptor stream :type t) (format stream "\(host ~A, port ~A)" @@ -150,41 +180,44 @@ (defgeneric start-listening (acceptor) (:documentation "Sets up a listen socket for the given ACCEPTOR and -enables it to listen for incoming connections. This function is -called from the thread that starts the acceptor initially and may -return errors resulting from the listening operation \(like 'address -in use' or similar).")) +enables it to listen to incoming connections. This function is called +from the thread that starts the acceptor initially and may return +errors resulting from the listening operation \(like 'address in use' +or similar).")) (defgeneric accept-connections (acceptor) - (:documentation "In a loop, accepts a connection and dispatches it + (:documentation "In a loop, accepts a connection and hands it over to the acceptor's taskmaster for processing using HANDLE-INCOMING-CONNECTION.")) (defgeneric initialize-connection-stream (acceptor stream) - (:documentation "Wraps the given STREAM with all the additional -stream classes to support the functionality required by ACCEPTOR. The -methods of this generic function must return the stream to use.")) + (:documentation "Can be used to modify the stream which is used to +communicate between client and server before the request is read. The +default method of ACCEPTOR does nothing, but see for example the +method defined for SSL-ACCEPTOR. All methods of this generic function +must return the stream to use.")) (defgeneric reset-connection-stream (acceptor stream) - (:documentation "Resets the given STREAM so that it can be used to -process the next request, ACCEPTOR is the acceptor that this stream -belongs to, which determines what to do to reset. This generic -function is called after a request has been processed and must return -the stream.")) + (:documentation "Resets the stream which is used to communicate +between client and server after one request has been served so that it +can be used to process the next request. This generic function is +called after a request has been processed and must return the +stream.")) (defgeneric process-connection (acceptor socket) (:documentation "This function is called by the taskmaster when a -new client connection has been established. Arguments are the -ACCEPTOR object and a usocket socket stream object \(or a LispWorks -socket handle) in SOCKET. It reads the request headers and hands over -to PROCESS-REQUEST. This is done in a loop until the stream has to be -closed or until a connection timeout occurs.")) +new client connection has been established. Its arguments are the +ACCEPTOR object and a LispWorks socket handle or a usocket socket +stream object in SOCKET. It reads the request headers, sets up the +request and reply objects, and hands over to PROCESS-REQUEST. This is +done in a loop until the stream has to be closed or until a connection +timeout occurs.")) (defgeneric acceptor-ssl-p (acceptor) (:documentation "Returns a true value if ACCEPTOR uses SSL connections. The default is to unconditionally return NIL and subclasses of ACCEPTOR must specialize this method to signal that -they're using secure connections.")) +they're using secure connections - see the SSL-ACCEPTOR class.")) ;; general implementation @@ -224,7 +257,7 @@ (t stream))) (defmethod process-connection :around ((*acceptor* acceptor) (socket t)) - "The around method is responsible for error handling." + ;; this around method is used for error handling (declare (ignore socket)) ;; note that this method also binds *ACCEPTOR* (handler-bind ((error @@ -247,7 +280,7 @@ (unwind-protect ;; process requests until either the acceptor is shut down, ;; *CLOSE-HUNCHENTOOT-STREAM* has been set to T by the - ;; handler or the peer fails to send a request. + ;; handler, or the peer fails to send a request (loop (let ((*close-hunchentoot-stream* t)) (when (acceptor-shutdown-p *acceptor*) @@ -297,10 +330,11 @@ (defun process-request (request) "This function is called by PROCESS-CONNECTION after the incoming -headers have been read. It sets up the REQUEST and REPLY objects, -selects and calls a handler, and finally sends the output to the -client using START-OUTPUT. If all goes as planned, the function -returns T." +headers have been read. It selects and calls a handler and sends the +output of this handler to the client using START-OUTPUT. It also sets +up simple error handling for the actual request handler. + +The return value of this function is ignored." (let (*tmp-files* *headers-sent*) (unwind-protect (let* ((*request* request)) @@ -333,12 +367,11 @@ (escape-for-html (format nil "~A" error)))) (error "An error has occured.") - (t body)))) - t) + (t body))))) (dolist (path *tmp-files*) (when (and (pathnamep path) (probe-file path)) ;; the handler may have chosen to (re)move the uploaded - ;; file, so ignore errors that happen during deletion. + ;; file, so ignore errors that happen during deletion (ignore-errors (delete-file path))))))) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-16 20:17:51 UTC (rev 4258) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-16 21:24:05 UTC (rev 4259) @@ -128,11 +128,11 @@ "ACCEPTOR-PERSISTENT-CONNECTIONS-P" "ACCEPTOR-PORT" "ACCEPTOR-READ-TIMEOUT" - "ACCEPTOR-REQUEST-CLASS" + "ACCEPTOR-REQUEST-CLASS" "ACCEPTOR-SSL-P" - "ACCEPTOR-SSL-CERTIFICATE-FILE" - "ACCEPTOR-SSL-PRIVATEKEY-FILE" - "ACCEPTOR-SSL-PRIVATEKEY-PASSWORD" + #-:hunchentoot-no-ssl "ACCEPTOR-SSL-CERTIFICATE-FILE" + #-:hunchentoot-no-ssl "ACCEPTOR-SSL-PRIVATEKEY-FILE" + #-:hunchentoot-no-ssl "ACCEPTOR-SSL-PRIVATEKEY-PASSWORD" "ACCEPTOR-WRITE-TIMEOUT" "AUTHORIZATION" "AUX-REQUEST-VALUE" @@ -234,7 +234,7 @@ "SET-COOKIE*" "SHUTDOWN" "SINGLE-THREADED-TASKMASTER" - "SSL-ACCEPTOR" + #-:hunchentoot-no-ssl "SSL-ACCEPTOR" "SSL-P" "START" "START-LISTENING" Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 20:17:51 UTC (rev 4258) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-16 21:24:05 UTC (rev 4259) @@ -47,9 +47,18 @@ private key file or NIL for no password.")) (:default-initargs :port 443) - (:documentation "This class defines additional slots required to -serve requests via SSL.")) + (:documentation "Create and START an instance of this class +\(instead of ACCEPTOR) if you want an https server. There are two +required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for +pathname designators denoting the certificate file and the key file in +PEM format. On LispWorks, you can have both in one file in which case +the second initarg is optional. On LispWorks, you can also use the +:SSL-PRIVATEKEY-PASSWORD initarg to provide a password \(as a string) +for the key file \(or NIL, the default, for no password). On other +Lisps, the key file must not be password-protected. +The default port for SSL-ACCEPTOR instances is 443 instead of 80")) + ;; general implementation (defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) @@ -85,9 +94,10 @@ "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the stream using the certificate file CERTIFICATE-FILE and the private key file PRIVATEKEY-FILE. Both of these values must be namestrings -denoting the location of the files. If PRIVATEKEY-PASSWORD is not NIL -then it should be the password for the private key file \(if -necessary). Returns the stream" +denoting the location of the files and will be fed directly to +OpenSSL. If PRIVATEKEY-PASSWORD is not NIL then it should be the +password for the private key file \(if necessary). Returns the +stream." (flet ((ctx-configure-callback (ctx) (when privatekey-password (comm:set-ssl-ctx-password-callback ctx :password privatekey-password)) From bknr at bknr.net Mon Feb 16 21:53:06 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 22:53:06 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4260 Author: edi URL: http://bknr.net/trac/changeset/4260 More documentation U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/taskmaster.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 21:24:05 UTC (rev 4259) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-16 21:53:06 UTC (rev 4260) @@ -105,7 +105,9 @@ #+:lispworks (process :accessor acceptor-process :documentation "The Lisp process which accepts incoming -requests.") +requests. This is the process started by COMM:START-UP-SERVER and no +matter what kind of taskmaster you are using this will always be a new +process different from the one where START was called.") #-:lispworks (listen-socket :accessor acceptor-listen-socket :documentation "The socket listening for incoming Modified: trunk/thirdparty/hunchentoot/taskmaster.lisp =================================================================== --- trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 21:24:05 UTC (rev 4259) +++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 21:53:06 UTC (rev 4260) @@ -31,22 +31,18 @@ (defclass taskmaster () ((acceptor :accessor taskmaster-acceptor - :documentation "The acceptor instance that this -taskmaster works for.")) - (:documentation "Base class for all taskmaster classes. Its purpose -is to carry the back pointer to the acceptor instance.")) + :documentation "A backpointer to the acceptor instance +this taskmaster works for.")) + (:documentation "An instance of this class is responsible for +distributing the work of handling requests when its acceptor ")) (defgeneric execute-acceptor (taskmaster) - (:documentation - "This function is called once Hunchentoot has performed all initial -processing to start listening for incoming connections. It does so by -calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from -the ACCEPTOR slot of the taskmaster instance. + (:documentation "This is a callback called by the acceptor once it +has performed all initial processing to start listening for incoming +connections \(see START-LISTENING). It usually calls the +ACCEPT-CONNECTIONS method of the acceptor, but depending on the +taskmaster instance the method might be called from a new thread.")) -In a multi-threaded environment, the taskmaster starts a new -thread and calls THUNK in that thread. In a single-threaded -environment, the thunk will be called directly.")) - (defgeneric handle-incoming-connection (taskmaster socket) (:documentation "This function is called by Hunchentoot to start processing of @@ -63,28 +59,36 @@ is called directly.")) (defgeneric shutdown (taskmaster) - (:documentation "Terminate all threads that are currently associated -with the taskmaster, if any.")) + (:documentation "Shuts down the taskmaster, i.e. frees all resources +that were set up by it. For example, a multi-threaded taskmaster +might terminate all threads that are currently associated with it.")) (defclass single-threaded-taskmaster (taskmaster) () - (:documentation "Taskmaster that runs synchronously in the -thread that invoked the START-SERVER function.")) + (:documentation "A taskmaster that runs synchronously in the thread +where the START function was invoked \(or in the case of LispWorks in +the thread started by COMM:START-UP-SERVER). This is the simplest +possible taskmaster implementation in that its methods do nothing but +calling their acceptor \"sister\" methods - EXECUTE-ACCEPTOR calls +ACCEPT-CONNECTIONS, HANDLE-INCOMING-CONNECTION calls +PROCESS-CONNECTION.")) (defmethod execute-acceptor ((taskmaster single-threaded-taskmaster)) + ;; in a single-threaded environment we just call ACCEPT-CONNECTIONS (accept-connections (taskmaster-acceptor taskmaster))) (defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket) + ;; in a single-threaded environment we just call PROCESS-CONNECTION (process-connection (taskmaster-acceptor taskmaster) socket)) (defclass one-thread-per-connection-taskmaster (taskmaster) - ((acceptor-process :accessor acceptor-process - :documentation "Process that accepts incoming + (#-:lispworks + (acceptor-process :accessor acceptor-process + :documentation "A process that accepts incoming connections and hands them off to new processes for request handling.")) - (:documentation "Taskmaster that starts one thread for -listening to incoming requests and one thread for each incoming -connection.")) + (:documentation "A taskmaster that starts one thread for listening +to incoming requests and one thread for each incoming connection.")) ;; usocket implementation @@ -104,7 +108,7 @@ (setf (acceptor-process taskmaster) (bt:make-thread (lambda () (accept-connections (taskmaster-acceptor taskmaster))) - :name (format nil "Hunchentoot acceptor \(~A:~A)" + :name (format nil "Hunchentoot listener \(~A:~A)" (or (acceptor-address (taskmaster-acceptor taskmaster)) "*") (acceptor-port (taskmaster-acceptor taskmaster)))))) From bknr at bknr.net Mon Feb 16 22:16:31 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 23:16:31 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4261 Author: edi URL: http://bknr.net/trac/changeset/4261 More documentation U trunk/thirdparty/hunchentoot/compat.lisp U trunk/thirdparty/hunchentoot/lispworks.lisp U trunk/thirdparty/hunchentoot/set-timeouts.lisp U trunk/thirdparty/hunchentoot/taskmaster.lisp Modified: trunk/thirdparty/hunchentoot/compat.lisp =================================================================== --- trunk/thirdparty/hunchentoot/compat.lisp 2009-02-16 21:53:06 UTC (rev 4260) +++ trunk/thirdparty/hunchentoot/compat.lisp 2009-02-16 22:16:31 UTC (rev 4261) @@ -99,10 +99,10 @@ (values (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket)) (usocket:get-peer-port socket))) -(defun make-socket-stream (socket server) - "Returns a stream for the socket SOCKET. The SERVER argument is +(defun make-socket-stream (socket acceptor) + "Returns a stream for the socket SOCKET. The ACCEPTOR argument is ignored." - (declare (ignore server)) + (declare (ignore acceptor)) (usocket:socket-stream socket)) (defun make-lock (name) Modified: trunk/thirdparty/hunchentoot/lispworks.lisp =================================================================== --- trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-16 21:53:06 UTC (rev 4260) +++ trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-16 22:16:31 UTC (rev 4261) @@ -55,14 +55,23 @@ (defvar *cleanup-interval* 100 "Should be NIL or a positive integer. The system calls -*CLEANUP-FUNCTION* whenever *CLEANUP-INTERVAL* new worker threads have -been created unless the value is NIL.") +*CLEANUP-FUNCTION* whenever *CLEANUP-INTERVAL* new worker threads +\(counted globally across all acceptors) have been created unless the +value is NIL. The initial value is 100. +This variable is only available on LispWorks.") + (defvar *cleanup-function* 'cleanup-function - "The function which is called if *CLEANUP-INTERVAL* is not NIL.") + "A designator for a function without arguments which is called on a +regular basis if *CLEANUP-INTERVAL* is not NIL. The initial value is +the name of a function which invokes a garbage collection on 32-bit +versions of LispWorks. +This variable is only available on LispWorks.") + (defvar *worker-counter* 0 - "Internal counter used to count worker threads.") + "Internal counter used to count worker threads. Needed for +*CLEANUP-FUNCTION*.") (defun cleanup-function () "The default for *CLEANUP-FUNCTION*. Invokes a GC on 32-bit Modified: trunk/thirdparty/hunchentoot/set-timeouts.lisp =================================================================== --- trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-16 21:53:06 UTC (rev 4260) +++ trunk/thirdparty/hunchentoot/set-timeouts.lisp 2009-02-16 22:16:31 UTC (rev 4261) @@ -29,21 +29,19 @@ (in-package :hunchentoot) -;;; system specific implementation of the function that sets up -;;; connection timeouts - (defun set-timeouts (usocket read-timeout write-timeout) "Sets up timeouts on the given USOCKET object. READ-TIMEOUT is the read timeout period, WRITE-TIMEOUT is the write timeout, specified in -seconds. The timeouts can either be implemented using the low-level -socket options SO_RCVTIMEO and SO_SNDTIMEO or some other, -implementation specific mechanism. On platforms that do not support -separate read and write timeouts, both must be equal or an error will -be signaled. READ-TIMEOUT and WRITE-TIMEOUT may be NIL, which means -that the corresponding socket timeout value will not be set." +\(fractional) seconds. The timeouts can either be implemented using +the low-level socket options SO_RCVTIMEO and SO_SNDTIMEO or some +other, implementation specific mechanism. On platforms that do not +support separate read and write timeouts, both must be equal or an +error will be signaled. READ-TIMEOUT and WRITE-TIMEOUT may be NIL, +which means that the corresponding socket timeout value will not be +set." (declare (ignorable usocket read-timeout write-timeout)) - #+:sbcl ;; add other Lisps here if necessary + #+(or :sbcl :cmu) (unless (eql read-timeout write-timeout) (parameter-error "Read and write timeouts for socket must be equal.")) #+:clisp Modified: trunk/thirdparty/hunchentoot/taskmaster.lisp =================================================================== --- trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 21:53:06 UTC (rev 4260) +++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-16 22:16:31 UTC (rev 4261) @@ -114,6 +114,8 @@ #-:lispworks (defun client-as-string (socket) + "A helper function which returns the client's address and port as a +string and tries to act robustly in the presence of network problems." (let ((address (usocket:get-peer-address socket)) (port (usocket:get-peer-port socket))) (when (and address port) From bknr at bknr.net Mon Feb 16 22:33:22 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 16 Feb 2009 23:33:22 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4262 Author: edi URL: http://bknr.net/trac/changeset/4262 More... U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/misc.lisp Modified: trunk/thirdparty/hunchentoot/easy-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-16 22:16:31 UTC (rev 4261) +++ trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-16 22:33:22 UTC (rev 4262) @@ -161,7 +161,7 @@ DESCRIPTION is either a symbol NAME or a list matching the destructuring lambda list - (name &key uri server-names default-parameter-type default-request-type). + (name &key uri acceptor-names default-parameter-type default-request-type). LAMBDA-LIST is a list the elements of which are either a symbol VAR or a list matching the destructuring lambda list @@ -182,11 +182,11 @@ function and applying this function to the current request object returns a true value. -SERVER-NAMES \(which is evaluated) can be a list of symbols which +ACCEPTOR-NAMES \(which is evaluated) can be a list of symbols which means that the handler will be returned by DISPATCH-EASY-HANDLERS in -servers which have one of these names \(see SERVER-NAME). -SERVER-NAMES can also be the symbol T which means that the handler -will be returned by DISPATCH-EASY-HANDLERS in every server. +acceptor which have one of these names \(see ACCEPTOR-NAME). +ACCEPTOR-NAMES can also be the symbol T which means that the handler +will be returned by DISPATCH-EASY-HANDLERS in every acceptor. Whether the GET or POST parameter \(or both) will be taken into consideration, depends on REQUEST-TYPE which can @@ -277,7 +277,7 @@ argument is provided." (when (atom description) (setq description (list description))) - (destructuring-bind (name &key uri (server-names t) + (destructuring-bind (name &key uri (acceptor-names t) (default-parameter-type ''string) (default-request-type :both)) description @@ -291,7 +291,7 @@ (or (equal ,uri (first list)) (eq ',name (third list)))) *easy-handler-alist*)) - (push (list ,uri ,server-names ',name) *easy-handler-alist*))))) + (push (list ,uri ,acceptor-names ',name) *easy-handler-alist*))))) (defun ,name (&key ,@(loop for part in lambda-list collect (make-defun-parameter part default-parameter-type @@ -310,9 +310,9 @@ (defun dispatch-easy-handlers (request) "This is a dispatcher which returns the appropriate handler defined with DEFINE-EASY-HANDLER, if there is one." - (loop for (uri server-names easy-handler) in *easy-handler-alist* - when (and (or (eq server-names t) - (find (acceptor-name *acceptor*) server-names :test #'eq)) + (loop for (uri acceptor-names easy-handler) in *easy-handler-alist* + when (and (or (eq acceptor-names t) + (find (acceptor-name *acceptor*) acceptor-names :test #'eq)) (cond ((stringp uri) (string= (script-name request) uri)) (t (funcall uri request)))) Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-16 22:16:31 UTC (rev 4261) +++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-16 22:33:22 UTC (rev 4262) @@ -189,9 +189,8 @@ (setf content (string-to-octets content :external-format (reply-external-format)))) (when content ;; whenever we know what we're going to send out as content, set - ;; the content-length header properly. It may be that the user - ;; specified a different Content-Length, but that will not be - ;; right. We might want to warn the user. + ;; the Content-Length header properly; maybe the user specified + ;; a different content length, but that will wrong anyway (setf (header-out :content-length) (length content))) ;; write all headers from the REPLY object (loop for (key . value) in (headers-out) @@ -233,7 +232,7 @@ (defun read-initial-request-line (stream) "Reads and returns the initial HTTP request line, catching permitted errors and handling *BREAK-EVEN-WHILE-READING-REQUEST-TYPE-P*. If no -request could be read, return NIL." +request could be read, returns NIL." (let ((*break-on-signals* (and *break-even-while-reading-request-type-p* *break-on-signals*))) (handler-case Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2009-02-16 22:16:31 UTC (rev 4261) +++ trunk/thirdparty/hunchentoot/misc.lisp 2009-02-16 22:33:22 UTC (rev 4262) @@ -109,9 +109,9 @@ (address-string))) (defun create-prefix-dispatcher (prefix handler) - "Creates a dispatch function which will dispatch to the -function denoted by HANDLER if the file name of the current -request starts with the string PREFIX." + "Creates a request dispatch function which will dispatch to the +function denoted by HANDLER if the file name of the current request +starts with the string PREFIX." (lambda (request) (let ((mismatch (mismatch (script-name request) prefix :test #'char=))) @@ -120,9 +120,9 @@ handler)))) (defun create-regex-dispatcher (regex handler) - "Creates a dispatch function which will dispatch to the -function denoted by HANDLER if the file name of the current -request matches the CL-PPCRE regular expression REGEX." + "Creates a request dispatch function which will dispatch to the +function denoted by HANDLER if the file name of the current request +matches the CL-PPCRE regular expression REGEX." (let ((scanner (create-scanner regex))) (lambda (request) (and (scan scanner (script-name request)) @@ -136,13 +136,13 @@ (defun handle-static-file (path &optional content-type) "A function which acts like a Hunchentoot handler for the file -denoted by PATH. Send a content type header corresponding to -CONTENT-TYPE or \(if that is NIL) tries to determine the content -type via the file's suffix." +denoted by PATH. Sends a content type header corresponding to +CONTENT-TYPE or \(if that is NIL) tries to determine the content type +via the file's suffix." (when (or (wild-pathname-p path) (not (fad:file-exists-p path)) (fad:directory-exists-p path)) - ;; does not exist + ;; file does not exist (setf (return-code) +http-not-found+) (abort-request-handler)) (let ((time (or (file-write-date path) (get-universal-time)))) @@ -166,10 +166,10 @@ (finish-output out)))))) (defun create-static-file-dispatcher-and-handler (uri path &optional content-type) - "Creates and returns a dispatch function which will dispatch to a -handler function which emits the file denoted by the pathname + "Creates and returns a request dispatch function which will dispatch +to a handler function which emits the file denoted by the pathname designator PATH with content type CONTENT-TYPE if the SCRIPT-NAME of -the request matches the string URI. If CONTENT-TYPE is NIL tries to +the request matches the string URI. If CONTENT-TYPE is NIL, tries to determine the content type via the file's suffix." ;; the dispatcher (lambda (request) From bknr at bknr.net Mon Feb 16 23:09:16 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 00:09:16 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4263 Author: edi URL: http://bknr.net/trac/changeset/4263 Do to REPLY what we did to REQUEST U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/reply.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/test/test-handlers.lisp Change set too large, please see URL above From bknr at bknr.net Mon Feb 16 23:24:50 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 00:24:50 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/reply.lisp Message-ID: Revision: 4264 Author: edi URL: http://bknr.net/trac/changeset/4264 Ouch... U trunk/thirdparty/hunchentoot/reply.lisp Modified: trunk/thirdparty/hunchentoot/reply.lisp =================================================================== --- trunk/thirdparty/hunchentoot/reply.lisp 2009-02-16 23:09:16 UTC (rev 4263) +++ trunk/thirdparty/hunchentoot/reply.lisp 2009-02-16 23:24:49 UTC (rev 4264) @@ -73,7 +73,7 @@ (defun headers-out* (&optional (reply *reply*)) "Returns an alist of the outgoing headers associated with the REPLY object REPLY." - (headers-out* reply)) + (headers-out reply)) (defun cookies-out* (&optional (reply *reply*)) "Returns an alist of the outgoing cookies associated with the From bknr at bknr.net Mon Feb 16 23:59:29 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 00:59:29 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/request.lisp Message-ID: Revision: 4265 Author: edi URL: http://bknr.net/trac/changeset/4265 Not really a fix... U trunk/thirdparty/hunchentoot/request.lisp Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-16 23:24:49 UTC (rev 4264) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-16 23:59:29 UTC (rev 4265) @@ -254,8 +254,12 @@ (setf (slot-value request 'raw-post-data) t))))))) (error (condition) (log-message :error "Error when reading POST parameters from body: ~A" condition) - ;; we assume it's not our fault... - (setf (return-code*) +http-bad-request+))))) + ;; this is not the right thing to do because it could happen + ;; that we aren't finished reading from the request stream and + ;; can't send a reply - to be revisited + (setf (return-code*) +http-bad-request+ + *close-hunchentoot-stream* t) + (abort-request-handler))))) (defun recompute-request-parameters (&key (request *request*) (external-format *hunchentoot-default-external-format*)) From bknr at bknr.net Tue Feb 17 07:35:16 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 08:35:16 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4266 Author: edi URL: http://bknr.net/trac/changeset/4266 Some doc additions while I'm waiting for a database U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-16 23:59:29 UTC (rev 4265) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 07:35:16 UTC (rev 4266) @@ -2663,16 +2663,13 @@

    Unfortunately, Jeff is at least as busy as I am so he didn't - find the time to finish a full release. But in spring?2004 I + find the time to finish a full release. But in spring?2004 I needed a documented version of the code for a client of mine who thought it would be good if the toolkit were publicly available under an open source license. So I took Jeff's code, refactored again (to sync with the changes I had done in the meantime), and added documentation. This resulted in TBNL?0.1.0 (which - initially required mod_lisp as its front-end). Jeff's code - (which includes a lot more stuff that I didn't use) is still - available from his own - website tbnl.org. + initially required mod_lisp as its front-end).

    In March?2005, Bob Hutchinson sent patches which enabled TBNL to @@ -2690,16 +2687,20 @@ most of TBNL and replaces it completely.

    - Hunchentoot?1.0.0, released in May 2008, is again a major + Hunchentoot?1.0.0, released in February 2009, is again a major rewrite and should be considered work in progress. It moved to - using the usocket network portability library and Bordeaux - Threads for threading, thereby removing most of the platform - dependent code in the Hunchentoot code. Threading behavior was - made controllable by the threaded keyword - argument - to START-SERVER. mod_lisp - support was removed in this release to simplify the code base - and due to the lack of interest. A significant part of the 1.0.0 + using + the usocket + and Bordeaux + Threads for non-LispWorks Lisps, thereby removing most of + the platform dependent code. Threading behaviour was made + controllable through the introduction of + taskmasters. mod_lisp + support and several other things were removed in this release to + simplify the code base (and partly due to the lack of interest). + Several architectural changes (lots of them not + backwards-compatible) were made to ease customization of + Hunchentoot's behaviour. A significant part of the 1.0.0 redesign was done by Hans H?bner.

    From bknr at bknr.net Tue Feb 17 07:40:57 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 08:40:57 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4267 Author: edi URL: http://bknr.net/trac/changeset/4267 More U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 07:35:16 UTC (rev 4266) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 07:40:57 UTC (rev 4267) @@ -2614,7 +2614,9 @@ listener, type 
    (hunchentoot-test:test-hunchentoot "http://localhost:4242")
    You will see some diagnostic output and a summary line that - reports whether any tests have failed. + reports whether any tests have failed. (You can also use the + example certificate and key files in the test directory and + start and test an https server instead.)

    From bknr at bknr.net Tue Feb 17 20:45:14 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 21:45:14 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/documentation-template/output.lisp Message-ID: Revision: 4268 Author: edi URL: http://bknr.net/trac/changeset/4268 Fix typo U trunk/thirdparty/documentation-template/output.lisp Modified: trunk/thirdparty/documentation-template/output.lisp =================================================================== --- trunk/thirdparty/documentation-template/output.lisp 2009-02-17 07:40:57 UTC (rev 4267) +++ trunk/thirdparty/documentation-template/output.lisp 2009-02-17 20:45:14 UTC (rev 4268) @@ -249,7 +249,7 @@ " package in alphabetical order linked to their corresponding documentation entries:" (:|clix:index|)) - (:|clix:chapter| :name "ack" :title "Ackknowledgements" + (:|clix:chapter| :name "ack" :title "Acknowledgements" (:p "This documentation was prepared with " (:a :href "http://weitz.de/documentation-template/" "DOCUMENTATION-TEMPLATE"))) From bknr at bknr.net Tue Feb 17 20:52:54 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 21:52:54 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4269 Author: edi URL: http://bknr.net/trac/changeset/4269 Starting with the HTML documentation... U trunk/thirdparty/hunchentoot/doc/index.xml Change set too large, please see URL above From bknr at bknr.net Tue Feb 17 21:28:19 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 22:28:19 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4270 Author: edi URL: http://bknr.net/trac/changeset/4270 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml Change set too large, please see URL above From bknr at bknr.net Tue Feb 17 21:31:28 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 22:31:28 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/documentation-template/output.lisp Message-ID: Revision: 4271 Author: edi URL: http://bknr.net/trac/changeset/4271 Not all functions are accessors... U trunk/thirdparty/documentation-template/output.lisp Modified: trunk/thirdparty/documentation-template/output.lisp =================================================================== --- trunk/thirdparty/documentation-template/output.lisp 2009-02-17 21:28:19 UTC (rev 4270) +++ trunk/thirdparty/documentation-template/output.lisp 2009-02-17 21:31:28 UTC (rev 4271) @@ -150,7 +150,7 @@ (setq other-entries (remove writer other-entries))) (t (with-html-output (*doc-output* nil :indent 2) - (:|clix:accessor| + (:|clix:function| :generic (and genericp "true") :specialized specializers :name (string-downcase symbol) From bknr at bknr.net Tue Feb 17 22:23:13 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 23:23:13 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4272 Author: edi URL: http://bknr.net/trac/changeset/4272 Checkpoint U trunk/thirdparty/hunchentoot/doc/clixdoc.xsl U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/test/script.lisp Change set too large, please see URL above From bknr at bknr.net Tue Feb 17 22:59:48 2009 From: bknr at bknr.net (BKNR Commits) Date: Tue, 17 Feb 2009 23:59:48 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4273 Author: edi URL: http://bknr.net/trac/changeset/4273 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 22:23:13 UTC (rev 4272) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 22:59:48 UTC (rev 4273) @@ -563,6 +563,111 @@ + + +If you want to modify what acceptors do, you should +subclass ACCEPTOR +(or SSL-ACCEPTOR) and specialize the generic +functions that constitute their behaviour. The life of an acceptor +looks like this: It is started with the function START which +immediately calls START-LISTENING and then applies the function +EXECUTE-ACCEPTOR to +its taskmaster. This function will +eventually call ACCEPT-CONNECTIONS which is +responsible for settings things up to wait for clients to connect. +For each connection which comes +in, HANDLE-INCOMING-CONNECTION is applied to the +taskmaster which will call PROCESS-CONNECTION. +PROCESS-CONNECTION +calls INITIALIZE-CONNECTION-STREAM before it does +anything else, then it selects and calls a function which handles +the request, and finally it sends +the reply to the client before it +calls RESET-CONNECTION-STREAM. If the connection +is persistent, this procedure is repeated (except for the +intialization step) in a loop until the connection is closed. The +acceptor is stopped with STOP. + +

    +If you just want to use the standard acceptors that come with +Hunchentoot, you don't need to know anything about the functions +listed in this section. +

    + + + acceptor + + | + + Sets up a listen socket for the given acceptor and +enables it to listen to incoming connections. This function is called +from the thread that starts the acceptor initially and may return +errors resulting from the listening operation (like 'address in use' +or similar). + + + + + acceptor + + nil + + In a loop, accepts a connection and hands it over +to the acceptor's taskmaster for processing using +HANDLE-INCOMING-CONNECTION. On LispWorks, this +function returns immediately, on other Lisps it returns only once the +acceptor has been stopped. + + + + + acceptor socket + + nil + + This function is called by the taskmaster when a +new client connection has been established. Its arguments are the +ACCEPTOR object and a LispWorks socket handle or a usocket socket +stream object in socket. It reads the request headers, sets up the +request and reply +objects, and hands over to (the unexported +function) PROCESS-REQUEST which selects and calls a +handler for the request and sends its reply to the client. This is +done in a loop until the stream has to be closed or until a connection +timeout occurs. + + + + + acceptor stream + + stream + + Can be used to modify the stream which is used +to communicate between client and server before the request is read. +The default method of ACCEPTOR does nothing, but +see for example the method defined +for SSL-ACCEPTOR. All methods of this generic +function must return the stream to use. + + + + + acceptor stream + + stream + + Resets the stream which is used to communicate +between client and server after one request has been served so that it +can be used to process the next request. This generic function is +called after a request has been processed and must return the +stream. + + + +     + +     @@ -1635,18 +1740,7 @@ format control and arguments. - - acceptor stream - - result - - Can be used to modify the stream which is used to -communicate between client and server before the request is read. The -default method of ACCEPTOR does nothing, but see for example the -method defined for SSL-ACCEPTOR. All methods of this generic function -must return the stream to use. - - + log-level format-string rest @@ -1752,20 +1846,7 @@ object REQUEST. - - acceptor socket - - result - - This function is called by the taskmaster when a -new client connection has been established. Its arguments are the -ACCEPTOR object and a LispWorks socket handle or a usocket socket -stream object in SOCKET. It reads the request headers, sets up the -request and reply objects, and hands over to PROCESS-REQUEST. This is -done in a loop until the stream has to be closed or until a connection -timeout occurs. - - + optional @@ -2063,18 +2144,7 @@ (see RFC 2617) for the realm REALM. - - acceptor stream - - result - - Resets the stream which is used to communicate -between client and server after one request has been served so that it -can be used to process the next request. This generic function is -called after a request has been processed and must return the -stream. - - + @@ -2419,18 +2489,7 @@ connections. Returns the acceptor. - - acceptor - - result - - Sets up a listen socket for the given ACCEPTOR and -enables it to listen to incoming connections. This function is called -from the thread that starts the acceptor initially and may return -errors resulting from the listening operation (like 'address in use' -or similar). - - + From bknr at bknr.net Tue Feb 17 23:31:17 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 00:31:17 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4274 Author: edi URL: http://bknr.net/trac/changeset/4274 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 22:59:48 UTC (rev 4273) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-17 23:31:17 UTC (rev 4274) @@ -377,7 +377,7 @@ acceptor - result + acceptor Stops acceptor so that it no longer accepts requests. @@ -667,7 +667,114 @@ + +As a "normal" Hunchentoot user, you can completely ignore taskmasters +and skip this section. But if you're still reading, here are the +dirty details: Each acceptor has a taskmaster +associated with it at creation time. It is the taskmaster's job to +distribute the work of accepting and handling incoming connections. +The acceptor calls the taskmaster if appropriate and the taskmaster +calls back into the acceptor. This is done using the generic +functions described in this and +the previous section. Hunchentoot +comes with two standard taskmaster implementations - one (which is the +default used on multi-threaded Lisps) which starts a new thread for +each incoming connection and one which handles all requests +sequentially. It should for example be relatively straightforward to +create a taskmaster which allocates threads from a fixed pool instead +of creating a new one for each connection. +

    +If you want to implement your own taskmasters, you should subclass +TASKMASTER and specialize the generic functions in this section. +

    + + + An instance of this class is responsible for +distributing the work of handling requests for its acceptor. +This is +an "abstract" class in the sense that usually only instances of +subclasses of TASKMASTER will be used. + + + + + A taskmaster that starts one thread for listening +to incoming requests and one thread for each incoming connection. +

    +This is the default taskmaster implementation for multi-threaded Lisp +implementations. +

    +     +     + + + A taskmaster that runs synchronously in the +thread where the START function was invoked (or +in the case of LispWorks in the thread started +by COMM:START-UP-SERVER). +This is the simplest possible taskmaster implementation in that its +methods do nothing but calling their acceptor "sister" +methods - EXECUTE-ACCEPTOR calls ACCEPT-CONNECTIONS, +HANDLE-INCOMING-CONNECTION calls PROCESS-CONNECTION. + + + + + taskmaster + + result + + This is a callback called by the acceptor once it +has performed all initial processing to start listening for incoming +connections (see START-LISTENING). It usually calls the +ACCEPT-CONNECTIONS method of the acceptor, but depending on the +taskmaster instance the method might be called from a new thread. + + + + + taskmaster socket + + result + + This function is called by the acceptor to start +processing of requests on a new incoming connection. socket is the +usocket instance that represents the new connection (or a socket +handle on LispWorks). The taskmaster starts processing requests on +the incoming connection by calling the PROCESS-CONNECTION +method of the acceptor instance. The socket argument is passed to +PROCESS-CONNECTION as an argument. + + + + + taskmaster + + taskmaster + + Shuts down the taskmaster, i.e. frees all resources +that were set up by it. For example, a multi-threaded taskmaster +might terminate all threads that are currently associated with it. +This function is called by the acceptor's STOP method. + + + + + taskmaster + + acceptor + + +This is an accessor for the slot of a TASKMASTER +object that links back to the acceptor it is +associated with. + + + +     + +     @@ -1516,18 +1623,7 @@ Escapes the characters #\<, #\>, #\', #\", and #\& for HTML output. - - taskmaster - - result - - This is a callback called by the acceptor once it -has performed all initial processing to start listening for incoming -connections (see START-LISTENING). It usually calls the -ACCEPT-CONNECTIONS method of the acceptor, but depending on the -taskmaster instance the method might be called from a new thread. - - + name optional @@ -1578,25 +1674,7 @@ TIME. - - taskmaster socket - - result - - This function is called by Hunchentoot to start processing of -requests on a new incoming connection. SOCKET is the usocket instance -that represents the new connection (or a socket handle on LispWorks). -The taskmaster starts processing requests on the incoming -connection by calling the START-REQUEST-PROCESSING function of the -acceptor instance, taken from the ACCEPTOR slot in the taskmaster -instance. The SOCKET argument is passed to START-REQUEST-PROCESSING -as argument. -In a multi-threaded environment, the taskmaster runs this function -in a separate thread. In a single-threaded environment, this function -is called directly. - - path optional @@ -1782,11 +1860,7 @@ Adds appropriate headers to completely prevent caching on most browsers. - - A taskmaster that starts one thread for listening -to incoming requests and one thread for each incoming connection. - - + name optional @@ -2449,26 +2523,6 @@ (case-sensitive) already exists, it is replaced. - - taskmaster - - result - - Shuts down the taskmaster, i.e. frees all resources -that were set up by it. For example, a multi-threaded taskmaster -might terminate all threads that are currently associated with it. - - - - A taskmaster that runs synchronously in the thread -where the START function was invoked (or in the case of LispWorks in -the thread started by COMM:START-UP-SERVER). This is the simplest -possible taskmaster implementation in that its methods do nothing but -calling their acceptor "sister" methods - EXECUTE-ACCEPTOR calls -ACCEPT-CONNECTIONS, HANDLE-INCOMING-CONNECTION calls -PROCESS-CONNECTION. - - @@ -2501,27 +2555,6 @@ - - An instance of this class is responsible for -distributing the work of handling requests when its acceptor - - - - taskmaster - - result - - - - - - (taskmaster taskmaster) - - result - - - - string optional From bknr at bknr.net Wed Feb 18 00:21:07 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 01:21:07 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4275 Author: edi URL: http://bknr.net/trac/changeset/4275 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml Change set too large, please see URL above From bknr at bknr.net Wed Feb 18 00:21:31 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 01:21:31 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4276 Author: edi URL: http://bknr.net/trac/changeset/4276 More changes U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/taskmaster.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:21:06 UTC (rev 4275) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:21:31 UTC (rev 4276) @@ -197,7 +197,9 @@ (defgeneric accept-connections (acceptor) (:documentation "In a loop, accepts a connection and hands it over to the acceptor's taskmaster for processing using -HANDLE-INCOMING-CONNECTION.")) +HANDLE-INCOMING-CONNECTION. On LispWorks, this function returns +immediately, on other Lisps it retusn only once the acceptor has been +stopped.")) (defgeneric initialize-connection-stream (acceptor stream) (:documentation "Can be used to modify the stream which is used to @@ -246,7 +248,8 @@ (setf (acceptor-shutdown-p acceptor) t) (shutdown (acceptor-taskmaster acceptor)) #-:lispworks - (usocket:socket-close (acceptor-listen-socket acceptor))) + (usocket:socket-close (acceptor-listen-socket acceptor)) + acceptor) (defmethod initialize-connection-stream ((acceptor acceptor) stream) (declare (ignore acceptor)) @@ -397,7 +400,8 @@ usocket:*wildcard-host*) (acceptor-port acceptor) :reuseaddress t - :element-type '(unsigned-byte 8)))) + :element-type '(unsigned-byte 8))) + (values)) #-:lispworks (defmethod accept-connections ((acceptor acceptor)) @@ -444,11 +448,13 @@ (when startup-condition (error startup-condition)) (mp:process-stop listener-process) - (setf (acceptor-process acceptor) listener-process))) + (setf (acceptor-process acceptor) listener-process) + (values))) #+:lispworks (defmethod accept-connections ((acceptor acceptor)) - (mp:process-unstop (acceptor-process acceptor))) + (mp:process-unstop (acceptor-process acceptor)) + nil) (defun list-handler-selector (request) "The default handler selector which selects a request handler based Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 00:21:06 UTC (rev 4275) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 00:21:31 UTC (rev 4276) @@ -120,6 +120,7 @@ "ACCEPTOR" "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" + "ACCEPT-CONNECTIONS" "ACCEPTOR-HANDLER-SELECTOR" "ACCEPTOR-INPUT-CHUNKING-P" "ACCEPTOR-MESSAGE-LOGGER" @@ -193,6 +194,7 @@ "POST-PARAMETERS" "POST-PARAMETERS*" "PROCESS-CONNECTION" + "QUERY-STRING" "QUERY-STRING*" "RAW-POST-DATA" "REAL-REMOTE-ADDR" Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 00:21:06 UTC (rev 4275) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 00:21:31 UTC (rev 4276) @@ -89,7 +89,7 @@ POST request, populated only if not a multipart/form-data request.")) (:documentation "Objects of this class hold all the information about an incoming request. They are created automatically by -Hunchentoot and can be accessed by the corresponding handler. +acceptors and can be accessed by the corresponding handler. You should not mess with the slots of these objects directly, but you can subclass REQUEST in order to implement your own behaviour. See Modified: trunk/thirdparty/hunchentoot/taskmaster.lisp =================================================================== --- trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-18 00:21:06 UTC (rev 4275) +++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-18 00:21:31 UTC (rev 4276) @@ -34,7 +34,9 @@ :documentation "A backpointer to the acceptor instance this taskmaster works for.")) (:documentation "An instance of this class is responsible for -distributing the work of handling requests when its acceptor ")) +distributing the work of handling requests for its acceptor. This is +an \"abstract\" class in the sense that usually only instances of +subclasses of TASKMASTER will be used.")) (defgeneric execute-acceptor (taskmaster) (:documentation "This is a callback called by the acceptor once it @@ -44,24 +46,19 @@ taskmaster instance the method might be called from a new thread.")) (defgeneric handle-incoming-connection (taskmaster socket) - (:documentation - "This function is called by Hunchentoot to start processing of -requests on a new incoming connection. SOCKET is the usocket instance -that represents the new connection \(or a socket handle on LispWorks). -The taskmaster starts processing requests on the incoming -connection by calling the START-REQUEST-PROCESSING function of the -acceptor instance, taken from the ACCEPTOR slot in the taskmaster -instance. The SOCKET argument is passed to START-REQUEST-PROCESSING -as argument. + (:documentation "This function is called by the acceptor to start +processing of requests on a new incoming connection. SOCKET is the +usocket instance that represents the new connection \(or a socket +handle on LispWorks). The taskmaster starts processing requests on +the incoming connection by calling the PROCESS-CONNECTION method of +the acceptor instance. The SOCKET argument is passed to +PROCESS-CONNECTION as an argument.")) -In a multi-threaded environment, the taskmaster runs this function -in a separate thread. In a single-threaded environment, this function -is called directly.")) - (defgeneric shutdown (taskmaster) (:documentation "Shuts down the taskmaster, i.e. frees all resources that were set up by it. For example, a multi-threaded taskmaster -might terminate all threads that are currently associated with it.")) +might terminate all threads that are currently associated with it. +This function is called by the acceptor's STOP method.")) (defclass single-threaded-taskmaster (taskmaster) () @@ -88,12 +85,16 @@ connections and hands them off to new processes for request handling.")) (:documentation "A taskmaster that starts one thread for listening -to incoming requests and one thread for each incoming connection.")) +to incoming requests and one thread for each incoming connection. +This is the default taskmaster implementation for multi-threaded Lisp +implementations.")) + ;; usocket implementation #-:lispworks -(defmethod shutdown ((taskmaster taskmaster))) +(defmethod shutdown ((taskmaster taskmaster)) + taskmaster) #-:lispworks (defmethod shutdown ((taskmaster one-thread-per-connection-taskmaster)) @@ -101,7 +102,8 @@ (loop (unless (bt:thread-alive-p (acceptor-process taskmaster)) (return)) - (sleep 1))) + (sleep 1)) + taskmaster) #-:lispworks (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster)) @@ -136,7 +138,8 @@ (when-let (process (acceptor-process (taskmaster-acceptor taskmaster))) ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER - (mp:process-kill process))) + (mp:process-kill process)) + taskmaster) #+:lispworks (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster)) From bknr at bknr.net Wed Feb 18 00:24:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 01:24:33 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4277 Author: edi URL: http://bknr.net/trac/changeset/4277 And more. U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 00:21:31 UTC (rev 4276) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 00:24:33 UTC (rev 4277) @@ -2634,7 +2634,7 @@ using the usocket and Bordeaux - Threads for non-LispWorks Lisps, thereby removing most of + Threads libraries for non-LispWorks Lisps, thereby removing most of the platform dependent code. Threading behaviour was made controllable through the introduction of taskmasters. mod_lisp @@ -2661,10 +2661,7 @@ Thanks to Jeff Caldwell - TBNL would not have been released - without his efforts. Thanks - to Marc Battyani for - mod_lisp and to Chris - Hanson for mod_lisp2. Thanks + without his efforts. Thanks to Stefan Scholl and Travis Cross for various additions and fixes to TBNL, to Michael @@ -2692,7 +2689,10 @@ Hunchentoot to other Lisps than LispWorks, I stole code from ACL-COMPAT, KMRCL, and trivial-sockets for - implementation-dependent stuff like sockets and MP. + implementation-dependent stuff like sockets and MP. (This has been replaced by + Bordeaux + Threads + and usocket.)

    Parts of this documentation were prepared From bknr at bknr.net Wed Feb 18 00:32:16 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 01:32:16 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4278 Author: edi URL: http://bknr.net/trac/changeset/4278 Enough for today U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:24:33 UTC (rev 4277) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:32:16 UTC (rev 4278) @@ -99,15 +99,13 @@ :documentation "The read timeout of the acceptor, specified in \(fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of -socket timeouts. NIL \(which is the default that you might want to -change for production environments) means no timeout.") +socket timeouts. NIL means no timeout.") (write-timeout :initarg :write-timeout :reader acceptor-write-timeout :documentation "The write timeout of the acceptor, specified in \(fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of -socket timeouts. NIL \(which is the default that you might want to -change for production environments) means no timeout.") +socket timeouts. NIL means no timeout.") #+:lispworks (process :accessor acceptor-process :documentation "The Lisp process which accepts incoming @@ -159,8 +157,8 @@ :output-chunking-p t :input-chunking-p t :persistent-connections-p t - :read-timeout nil - :write-timeout nil + :read-timeout *default-connection-timeout* + :write-timeout *default-connection-timeout* :access-logger 'log-access-to-file :message-logger 'log-message-to-file) (:documentation "To create a Hunchentoot webserver, you make an Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 00:24:33 UTC (rev 4277) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 00:32:16 UTC (rev 4278) @@ -1077,9 +1077,30 @@ + + + + + + + + + + + + + + + + + + + + + @@ -1986,18 +2007,8 @@ Superclass for all errors related to Hunchentoot. - - format-control - rest - format-arguments - - result - - Signals an error of type HUNCHENTOOT-SIMPLE-ERROR with the provided -format control and arguments. - - + log-level format-string rest @@ -2475,15 +2486,6 @@ Whether the current connection to the client is secure. - - acceptor - - result - - Starts the ACCEPTOR so that it begins accepting -connections. Returns the acceptor. - - Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-18 00:24:33 UTC (rev 4277) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-18 00:32:16 UTC (rev 4278) @@ -308,8 +308,8 @@ "Length of buffers used for internal purposes.") (defvar *default-connection-timeout* 20 - "The default connection timeout used when a Hunchentoot server is -reading from and writing to a socket stream.") + "The default connection timeout used when an acceptor is reading +from and writing to a socket stream.") (defvar-unbound *local-host* "Bound to a string denoting the address at which the current From bknr at bknr.net Wed Feb 18 14:57:40 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 15:57:40 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4279 Author: hans URL: http://bknr.net/trac/changeset/4279 Warn about unbound *session-secret* when sessions are first used, not upon startup. Rename handler-selector to request-dispatcher. Make PROCESS-REQUEST a generic function and export it so that applications can bind special variables early in the request processing chain. U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -62,13 +62,13 @@ objects is created when a request is served in and should be \(a symbol naming) a class which inherits from REPLY. The default is the symbol REPLY.") - (handler-selector :initarg :handler-selector - :accessor acceptor-handler-selector - :documentation "A designator for the handler -selector function used by this acceptor. A function which accepts a + (request-dispatcher :initarg :request-dispatcher + :accessor acceptor-request-dispatcher + :documentation "A designator for the request +dispatcher function used by this acceptor. A function which accepts a REQUEST object and calls a request handler of its choice \(and returns its return value). The default is the unexported symbol -LIST-HANDLER-SELECTOR which works through the list *DISPATCH-TABLE*.") +LIST-REQUEST-DISPATCHER which works through the list *DISPATCH-TABLE*.") (taskmaster :initarg :taskmaster :reader acceptor-taskmaster :documentation "The taskmaster \(i.e. an instance of a @@ -151,7 +151,7 @@ :name (gensym) :request-class 'request :reply-class 'reply - :handler-selector 'list-handler-selector + :request-dispatcher 'list-request-dispatcher :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-taskmaster) (t 'single-threaded-taskmaster))) :output-chunking-p t @@ -230,11 +230,6 @@ ;; general implementation -(defmethod start :before ((acceptor acceptor)) - (unless (boundp '*session-secret*) - (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") - (reset-session-secret))) - (defmethod start ((acceptor acceptor)) (start-listening acceptor) (let ((taskmaster (acceptor-taskmaster acceptor))) @@ -286,7 +281,6 @@ (defmethod process-connection ((*acceptor* acceptor) (socket t)) (let ((*hunchentoot-stream* (initialize-connection-stream *acceptor* (make-socket-stream socket *acceptor*)))) - (print *hunchentoot-stream*) (unwind-protect ;; process requests until either the acceptor is shut down, ;; *CLOSE-HUNCHENTOOT-STREAM* has been set to T by the @@ -337,53 +331,6 @@ (ignore-errors (force-output *hunchentoot-stream*) (close *hunchentoot-stream* :abort t)))))) - -(defun process-request (request) - "This function is called by PROCESS-CONNECTION after the incoming -headers have been read. It selects and calls a handler and sends the -output of this handler to the client using START-OUTPUT. It also sets -up simple error handling for the actual request handler. - -The return value of this function is ignored." - (let (*tmp-files* *headers-sent*) - (unwind-protect - (let* ((*request* request)) - (multiple-value-bind (body error) - (catch 'handler-done - (handler-bind ((error - (lambda (cond) - (when *log-lisp-errors-p* - (log-message *lisp-errors-log-level* "~A" cond)) - ;; if the headers were already sent - ;; the error happens within the body - ;; and we have to close the stream - (when *headers-sent* - (setq *close-hunchentoot-stream* t)) - (throw 'handler-done - (values nil cond)))) - (warning - (lambda (cond) - (when *log-lisp-warnings-p* - (log-message *lisp-warnings-log-level* "~A" cond))))) - ;; skip dispatch if bad request - (when (eql (return-code *reply*) +http-ok+) - ;; now do the work - (funcall (acceptor-handler-selector *acceptor*) *request*)))) - (when error - (setf (return-code *reply*) - +http-internal-server-error+)) - (start-output :content (cond ((and error *show-lisp-errors-p*) - (format nil "

    ~A
    " - (escape-for-html (format nil "~A" error)))) - (error - "An error has occured.") - (t body))))) - (dolist (path *tmp-files*) - (when (and (pathnamep path) (probe-file path)) - ;; the handler may have chosen to (re)move the uploaded - ;; file, so ignore errors that happen during deletion - (ignore-errors - (delete-file path))))))) (defmethod acceptor-ssl-p ((acceptor t)) ;; the default is to always answer "no" @@ -454,7 +401,7 @@ (mp:process-unstop (acceptor-process acceptor)) nil) -(defun list-handler-selector (request) +(defun list-request-dispatcher (request) "The default handler selector which selects a request handler based on a list of individual request dispatchers all of which can either return a handler or neglect by returning NIL." Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -121,7 +121,7 @@ "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" "ACCEPT-CONNECTIONS" - "ACCEPTOR-HANDLER-SELECTOR" + "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-INPUT-CHUNKING-P" "ACCEPTOR-MESSAGE-LOGGER" "ACCEPTOR-NAME" @@ -194,6 +194,7 @@ "POST-PARAMETERS" "POST-PARAMETERS*" "PROCESS-CONNECTION" + "PROCESS-REQUEST" "QUERY-STRING" "QUERY-STRING*" "RAW-POST-DATA" Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -95,6 +95,14 @@ can subclass REQUEST in order to implement your own behaviour. See the REQUEST-CLASS slot of the ACCEPTOR class.")) +(defgeneric process-request (request) + (:documentation "This function is called by PROCESS-CONNECTION after the incoming +headers have been read. It selects and calls a handler and sends the +output of this handler to the client using START-OUTPUT. It also sets +up simple error handling for the actual request handler. + +The return value of this function is ignored.")) + (defun convert-hack (string external-format) "The rfc2388 package is buggy in that it operates on a character stream and thus only accepts encodings which are 8 bit transparent. @@ -195,6 +203,50 @@ ;; we assume it's not our fault... (setf (return-code*) +http-bad-request+))))) +(defmethod process-request (request) + + "Standard implementation for processing a request." + + (let (*tmp-files* *headers-sent*) + (unwind-protect + (let* ((*request* request)) + (multiple-value-bind (body error) + (catch 'handler-done + (handler-bind ((error + (lambda (cond) + (when *log-lisp-errors-p* + (log-message *lisp-errors-log-level* "~A" cond)) + ;; if the headers were already sent + ;; the error happens within the body + ;; and we have to close the stream + (when *headers-sent* + (setq *close-hunchentoot-stream* t)) + (throw 'handler-done + (values nil cond)))) + (warning + (lambda (cond) + (when *log-lisp-warnings-p* + (log-message *lisp-warnings-log-level* "~A" cond))))) + ;; skip dispatch if bad request + (when (eql (return-code *reply*) +http-ok+) + ;; now do the work + (funcall (acceptor-request-dispatcher *acceptor*) *request*)))) + (when error + (setf (return-code *reply*) + +http-internal-server-error+)) + (start-output :content (cond ((and error *show-lisp-errors-p*) + (format nil "
    ~A
    " + (escape-for-html (format nil "~A" error)))) + (error + "An error has occured.") + (t body))))) + (dolist (path *tmp-files*) + (when (and (pathnamep path) (probe-file path)) + ;; the handler may have chosen to (re)move the uploaded + ;; file, so ignore errors that happen during deletion + (ignore-errors + (delete-file path))))))) + (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/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -129,6 +129,9 @@ USER-AGENT, REMOTE-ADDR, and START" ;; *SESSION-SECRET* is used twice due to known theoretical ;; vulnerabilities of MD5 encoding + (unless (boundp '*session-secret*) + (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") + (reset-session-secret)) (md5-hex (concatenate 'string *session-secret* (md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A" From bknr at bknr.net Wed Feb 18 19:58:57 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 20:58:57 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4280 Author: edi URL: http://bknr.net/trac/changeset/4280 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 14:57:40 UTC (rev 4279) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 19:58:57 UTC (rev 4280) @@ -63,12 +63,13 @@ symbol naming) a class which inherits from REPLY. The default is the symbol REPLY.") (request-dispatcher :initarg :request-dispatcher - :accessor acceptor-request-dispatcher - :documentation "A designator for the request + :accessor acceptor-request-dispatcher + :documentation "A designator for the request dispatcher function used by this acceptor. A function which accepts a REQUEST object and calls a request handler of its choice \(and returns its return value). The default is the unexported symbol -LIST-REQUEST-DISPATCHER which works through the list *DISPATCH-TABLE*.") +LIST-REQUEST-DISPATCHER which works through the list +*DISPATCH-TABLE*.") (taskmaster :initarg :taskmaster :reader acceptor-taskmaster :documentation "The taskmaster \(i.e. an instance of a @@ -220,8 +221,14 @@ stream object in SOCKET. It reads the request headers, sets up the request and reply objects, and hands over to PROCESS-REQUEST. This is done in a loop until the stream has to be closed or until a connection -timeout occurs.")) +timeout occurs. +It is probably not a good idea to re-implement this method until you +really, really know what you're doing, but you can for example write +an around method specialized for your subclass of ACCEPTOR which binds +or rebinds special variables which can then be accessed by your +handlers.")) + (defgeneric acceptor-ssl-p (acceptor) (:documentation "Returns a true value if ACCEPTOR uses SSL connections. The default is to unconditionally return NIL and @@ -402,9 +409,9 @@ nil) (defun list-request-dispatcher (request) - "The default handler selector which selects a request handler based -on a list of individual request dispatchers all of which can either -return a handler or neglect by returning NIL." + "The default request dispatcher which selects a request handler +based on a list of individual request dispatchers all of which can +either return a handler or neglect by returning NIL." (loop for dispatcher in *dispatch-table* for action = (funcall dispatcher request) when action return (funcall action) Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 14:57:40 UTC (rev 4279) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 19:58:57 UTC (rev 4280) @@ -605,6 +605,15 @@ handler for the request and sends its reply to the client. This is done in a loop until the stream has to be closed or until a connection timeout occurs. + +

    +It is probably not a good idea to re-implement this method until you +really, really know what you're doing, but you can for example write +an around method specialized for your subclass +of ACCEPTOR which binds or rebinds special +variables which can then be accessed by +your handlers. +

     Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 14:57:40 UTC (rev 4279) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 19:58:57 UTC (rev 4280) @@ -96,11 +96,18 @@ the REQUEST-CLASS slot of the ACCEPTOR class.")) (defgeneric process-request (request) - (:documentation "This function is called by PROCESS-CONNECTION after the incoming -headers have been read. It selects and calls a handler and sends the -output of this handler to the client using START-OUTPUT. It also sets -up simple error handling for the actual request handler. + (:documentation "This function is called by PROCESS-CONNECTION after +the incoming headers have been read. It selects and calls a handler +and sends the output of this handler to the client using START-OUTPUT. +It also sets up simple error handling for the actual request handler. +Note that PROCESS-CONNECTION is called once per connection and loops +in case of a persistent connection while PROCESS-REQUEST is called +anew for each request. +Like PROCESS-CONNECTION, this might be a good place to introduce +around methods which bind special variables or do other interesting +things. + The return value of this function is ignored.")) (defun convert-hack (string external-format) @@ -204,9 +211,9 @@ (setf (return-code*) +http-bad-request+))))) (defmethod process-request (request) - - "Standard implementation for processing a request." - + "Standard implementation for processing a request. You should not +change or replace this functionality unless you know what you're +doing." (let (*tmp-files* *headers-sent*) (unwind-protect (let* ((*request* request)) Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 14:57:40 UTC (rev 4279) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 19:58:57 UTC (rev 4280) @@ -127,11 +127,11 @@ (defun encode-session-string (id user-agent remote-addr start) "Creates a uniquely encoded session string based on the values ID, USER-AGENT, REMOTE-ADDR, and START" - ;; *SESSION-SECRET* is used twice due to known theoretical - ;; vulnerabilities of MD5 encoding (unless (boundp '*session-secret*) (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") (reset-session-secret)) + ;; *SESSION-SECRET* is used twice due to known theoretical + ;; vulnerabilities of MD5 encoding (md5-hex (concatenate 'string *session-secret* (md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A" From bknr at bknr.net Wed Feb 18 20:28:27 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 21:28:27 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4281 Author: edi URL: http://bknr.net/trac/changeset/4281 Document logging U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 19:58:57 UTC (rev 4280) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 20:28:27 UTC (rev 4281) @@ -139,9 +139,9 @@ :accessor acceptor-message-logger :documentation "Designator for a function to call to log messages by the acceptor. It must accept a severity level for -the message, which will be one of :NOTICE, :INFO, or :WARNING, a -format string and an arbitary number of formatting arguments. This -slot defaults to a function which writes to the file determined by +the message, which will be one of :ERROR, :INFO, or :WARNING, a format +string and an arbitary number of formatting arguments. This slot +defaults to a function which writes to the file determined by *MESSAGE-LOG-PATHNAME* \(unless that value is NIL). If the value of this slot is NIL, message logging is turned off for Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 19:58:57 UTC (rev 4280) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 20:28:27 UTC (rev 4281) @@ -384,6 +384,11 @@ + + The current ACCEPTOR object in the context of a request. + + + acceptor @@ -450,10 +455,10 @@ - + acceptor - handler-selector + request-dispatcher @@ -600,11 +605,10 @@ ACCEPTOR object and a LispWorks socket handle or a usocket socket stream object in socket. It reads the request headers, sets up the request and reply -objects, and hands over to (the unexported -function) PROCESS-REQUEST which selects and calls a -handler for the request and sends its reply to the client. This is -done in a loop until the stream has to be closed or until a connection -timeout occurs. +objects, and hands over to PROCESS-REQUEST which +selects and calls a handler for the request and sends its reply to the +client. This is done in a loop until the stream has to be closed or +until a connection timeout occurs.

    It is probably not a good idea to re-implement this method until you @@ -1102,6 +1106,90 @@ + +By default, Hunchentoot logs accesses and errors to two separate files +in the file system, but only if the special variables +*MESSAGE-LOG-PATHNAME* and *ACCESS-LOG-PATHNAME* are set accordingly. +Access logging is done in a format similar to what +the Apache web server can write so that logfile analysis using +standard tools is possible. Errors during request processing are +logged to a separate file. +

    +The standard logging mechanism is deliberately simple and slow. The +log files are opened for each log entry and closed again after +writing, and access to them is protected by a global lock. If you +want more sophisticated logging, use +the :access-logger +and :message-logger +initargs of the acceptor class to establish your own logging +functions. See the docstrings of the corresponding slots for more +information. +

    +

    +Errors happening within a handler which are +not caught by the handler itself are handled by Hunchentoot by logging +them to the log file. +

    + + + log-level format-string + rest + format-arguments + + result + + Convenience function which calls the message +logger of the current acceptor (if there is one) with the same +arguments it accepts. Returns NIL if there is no message +logger or whatever the message logger returns. +

    +This is the function which Hunchentoot itself uses to log errors it +catches during request processing. +

    +     +     + + + +A designator for the pathname of the message log file used by the +default message logger. The initial value is NIL which +means that nothing will be logged! + + + + + +A designator for the pathname of the access log file used by the +default access logger. The initial value is NIL which +means that nothing will be logged! + + + + + Whether Lisp errors in request handlers should be logged. + + + + + Whether Lisp warnings in request handlers should be logged. + + + + + Log level for Lisp errors. Should be one +of :ERROR (the default), :WARNING, +or :INFO. + + + + + Log level for Lisp warnings. +Should be one of :ERROR, :WARNING +(the default), or :INFO. + + + + @@ -1113,16 +1201,7 @@     - - The current ACCEPTOR object. - - - - A designator for the pathname of the access log file used by the -LOG-ACCESS-TO-FILE function. The initial value is NIL which means -that nothingq will be logged. - - + A list of return codes the server should not treat as an error - see *HANDLE-HTTP-ERRORS-P*. @@ -1202,28 +1281,7 @@ The external format used to compute the REQUEST object. - - Log level for Lisp errors. - - - - Log level for Lisp warnings. - - - - Whether Lisp errors should be logged. - - - - Whether Lisp warnings should be logged. - - - - A designator for the pathname of the message log file used by the -LOG-MESSAGE-TO-FILE function. The initial value is NIL which means -that nothing will be logged. - - + A list of the request method types (as keywords) for which Hunchentoot will try to compute POST-PARAMETERS. @@ -2018,17 +2076,6 @@ - - log-level format-string - rest - format-arguments - - result - - Convenience function which calls the message logger of the current -acceptor (if there is one) with the same arguments it accepts. - - pathspec @@ -2548,6 +2595,33 @@ name doesn't exist, it is created. + + + + request + + nil + + +This function is called by PROCESS-CONNECTION +after the incoming headers have been read. It selects and calls a +handler and sends the output of this handler to the client. It also +sets up simple error handling for the request handler. Note +that PROCESS-CONNECTION is called once per +connection and loops in case of a persistent connection +while PROCESS-REQUEST is called anew for each +request. +

    +Like PROCESS-CONNECTION, this might be a good +place to introduce around methods which bind special variables or do +other interesting things. +

    +

    +The return value of this function is ignored. +

    +     +     +     Modified: trunk/thirdparty/hunchentoot/log.lisp =================================================================== --- trunk/thirdparty/hunchentoot/log.lisp 2009-02-18 19:58:57 UTC (rev 4280) +++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-18 20:28:27 UTC (rev 4281) @@ -30,6 +30,11 @@ (in-package :hunchentoot) (defmacro with-log-file ((stream-var pathname lock) &body body) + "Helper macro which executes BODY only if PATHNAME \(which is +evaluated) is not NIL. In this case, the file designated by PATHNAME +is opened for writing \(appending) and created if it doesn't exist. +STREAM-VAR is then bound to a flexi stream which can be used to write +characters to the file in UTF-8 format." (with-unique-names (binary-stream) (with-rebinding (pathname) `(when ,pathname @@ -77,7 +82,13 @@ (defun log-message (log-level format-string &rest format-arguments) "Convenience function which calls the message logger of the current -acceptor \(if there is one) with the same arguments it accepts." +acceptor \(if there is one) with the same arguments it accepts. + +Returns NIL if there is no message logger or whatever the message +logger returns. + +This is the function which Hunchentoot itself uses to log errors it +catches during request processing." (when-let (message-logger (acceptor-message-logger *acceptor*)) (apply message-logger log-level format-string format-arguments))) Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 19:58:57 UTC (rev 4280) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 20:28:27 UTC (rev 4281) @@ -99,10 +99,10 @@ (:documentation "This function is called by PROCESS-CONNECTION after the incoming headers have been read. It selects and calls a handler and sends the output of this handler to the client using START-OUTPUT. -It also sets up simple error handling for the actual request handler. -Note that PROCESS-CONNECTION is called once per connection and loops -in case of a persistent connection while PROCESS-REQUEST is called -anew for each request. +It also sets up simple error handling for the request handler. Note +that PROCESS-CONNECTION is called once per connection and loops in +case of a persistent connection while PROCESS-REQUEST is called anew +for each request. Like PROCESS-CONNECTION, this might be a good place to introduce around methods which bind special variables or do other interesting Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-18 19:58:57 UTC (rev 4280) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-18 20:28:27 UTC (rev 4281) @@ -194,19 +194,21 @@ purposes.") (defvar *show-lisp-errors-p* nil - "Whether Lisp errors should be shown in HTML output.") + "Whether Lisp errors in request handlers should be shown in HTML output.") (defvar *log-lisp-errors-p* t - "Whether Lisp errors should be logged.") + "Whether Lisp errors in request handlers should be logged.") (defvar *log-lisp-warnings-p* t - "Whether Lisp warnings should be logged.") + "Whether Lisp warnings in request handlers should be logged.") (defvar *lisp-errors-log-level* :error - "Log level for Lisp errors.") + "Log level for Lisp errors. Should be one of :ERROR \(the default), +:WARNING, or :INFO.") (defvar *lisp-warnings-log-level* :warning - "Log level for Lisp warnings.") + "Log level for Lisp warnings. Should be one of :ERROR, :WARNING +\(the default), or :INFO.") (defvar *message-log-pathname* nil "A designator for the pathname of the message log file used by the @@ -216,7 +218,7 @@ (defvar *access-log-pathname* nil "A designator for the pathname of the access log file used by the LOG-ACCESS-TO-FILE function. The initial value is NIL which means -that nothingq will be logged.") +that nothing will be logged.") (defvar *message-log-lock* (make-lock "global-message-log-lock") "A global lock to prevent concurrent access to the log file From bknr at bknr.net Wed Feb 18 21:25:42 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 22:25:42 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4282 Author: edi URL: http://bknr.net/trac/changeset/4282 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp Change set too large, please see URL above From bknr at bknr.net Wed Feb 18 22:12:41 2009 From: bknr at bknr.net (BKNR Commits) Date: Wed, 18 Feb 2009 23:12:41 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4283 Author: edi URL: http://bknr.net/trac/changeset/4283 Sessions U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/session.lisp Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 21:25:42 UTC (rev 4282) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 22:12:41 UTC (rev 4283) @@ -1136,16 +1136,6 @@ not too old. Old sessions are automatically removed.

    -

    -For everyday session usage, you will probably just -use START-SESSION, -SESSION-VALUE, -maybe DELETE-SESSION-VALUE -and *SESSION*. However, there are two ways to -customize the way Hunchentoot maintains sessions: -

    -

    -

    SESSION objects are @@ -1218,6 +1208,29 @@ + + session + + | + + Completely removes +the SESSION object session +from Hunchentoot's internal session +database. + + + + + + + + | + + Removes all stored sessions. + + + + Whether HTML pages should possibly be rewritten for cookie-less session-management. @@ -1231,38 +1244,7 @@ - - A session GC (see function SESSION-GC) will happen every -*SESSION-GC-FREQUENCY* requests (counting only -requests which create a new session) if this variable is -not NIL. See SESSION-CREATED. - - - - The default time (in seconds) after which a session times out. - - - - - A function of one argument -(a SESSION object) which is called whenever a -session is garbage-collected. - - - - - A random ASCII string that's used to encode -the public session data. This variable is initially unbound and will -be set (using RESET-SESSION-SECRET) the first -time a session is created, if necessary. You can prevent this from -happening if you set the value yourself before -starting acceptors. - - - - - Whether the client's remote IP (as returned by REAL-REMOTE-ADDR) should be encoded into the session string. If this value is true, a @@ -1274,97 +1256,208 @@ + + session + + remote-addr + + +The remote IP address of the client when this session was started as +returned by REAL-REMOTE-ADDR. + + + + - Whether the 'User-Agent' header should be encoded into the session -string. If this value is true, a session will cease to be accessible -if the client sends a different 'User-Agent' header. + Whether the 'User-Agent' header should +be encoded into the session string. If this value is true, a session +will cease to be accessible if the client sends a different +'User-Agent' header. - - - acceptor + + session - id + user-agent - Returns the next sequential session ID, an -integer, which should be unique per session. The default method uses -a simple global counter and isn't guarded by a lock. For a -high-performance production environment you might consider to use a -more robust implementation. + +The incoming 'User-Agent' header that +was sent when this session was created. - + session + max-time + + +Gets or sets the time (in seconds) after +which session expires if it's not used. + + + + + + The default time (in seconds) after which a session times out. + + + + + A session GC (see function SESSION-GC) will happen every +*SESSION-GC-FREQUENCY* requests (counting only +requests which create a new session) if this variable is +not NIL. See SESSION-CREATED. + + + + + + | - Completely removes the SESSION object SESSION from Hunchentoot's -internal session database. + Removes sessions from the current session database which are too +old - see SESSION-TOO-OLD-P. - - + + session - secret + generalized-boolean - Sets *SESSION-SECRET* to a new random value. All old sessions will -cease to be valid. + Returns true if the SESSION object session has not been active in +the last (session-max-time session) seconds. - + + + A function of one argument +(a SESSION object) which is called whenever a +session is garbage-collected. + + + + + + + + + +For everyday session usage, you will probably just +use START-SESSION, +SESSION-VALUE, +maybe DELETE-SESSION-VALUE +and *SESSION*. However, there are two ways to +customize the way Hunchentoot maintains sessions. +

    +One way is to mostly leave the session mechanism intact but to tweak +it a bit: +

      +
    • The publicly visible part of session is encoded using a +secret which you can set yourself.
      • +
    • And it is stored using a cookie (or GET +parameter) name that you can +override.
      • +
    • Each session receives a new ID when +it is created and you can implement a more robust way to do that.
      • +
    • You can arrange to be called whenever a session +is created to trigger some action. You +might also do this to invent your own +session garbage collection.
      • +
    • By default, all sessions are stored in a global alist in memory. +You can't change the alist part, but you can distribute your sessions +amongst different "databases".
      • +
    • By default, every operation which modifies sessions or one of the +session databases is guarded by a global lock, but you can arrange to +provide different locks for this.
      • +
    +

    +

    +The other way to customize Hunchentoot's sessions is to completely +replace them. This is actually pretty easy: Create your own class to +store state (which doesn't have to and probably shouldn't inherit +from SESSION) and implement methods for +SESSION-VERIFY +and SESSION-COOKIE-VALUE - that's it. +Hunchentoot will continue to use cookies and/or to rewrite URLs to +keep track of session state and it will store "the current session" +(whatever that is in your implementation) +in *SESSION*. Everything else (like persisting +sessions, GC, getting and setting values) you'll have to take care of +yourself and the other session functions +(like START-SESSION or +SESSION-VALUE) won't work anymore. (Almost) +total freedom, but a lot of responsibility as well... :) +

    + + + A random ASCII string that's used to encode +the public session data. This variable is initially unbound and will +be set (using RESET-SESSION-SECRET) the first +time a session is created, if necessary. You can prevent this from +happening if you set the value yourself before +starting acceptors. + + + + - | + secret - Removes ALL stored sessions. + Sets *SESSION-SECRET* to a +new random value. All old sessions will cease to be valid. + + acceptor name - Returns the name (a string) of the cookie (or the -GET parameter) which is used to store a session on the client side. -The default is to use the string "hunchentoot-session", but you can + Returns the name (a string) of the cookie (or +the GET parameter) which is used to store a session on the client +side. The default is to use the +string "hunchentoot-session", but you can specialize this function if you want another name. - - session - - string - - Returns a string which can be used to safely -restore the session SESSION if as session has already been -established. This is used as the value stored in the session cookie -or in the corresponding GET parameter. A default method is provided -and there's no reason to change it unless you want to use your own -session objects. - - - acceptor new-session result - This function is called whenever a new session has -been created. There's a default method which might trigger a session -GC based on the value of *SESSION-GC-FREQUENCY*. + This function is called whenever a new session +has been created. There's a default method which might trigger +a session GC based on the value of +*SESSION-GC-FREQUENCY*.

    The return value is ignored.

    + + + acceptor + + id + + Returns the next sequential session ID, an +integer, which should be unique per session. The default method uses +a simple global counter and isn't guarded by a lock. For a +high-performance production environment you might consider to use a +more robust implementation. + + + acceptor @@ -1372,8 +1465,8 @@ Returns the current session database which is an alist where each car is a session's ID and the cdr is the -corresponding SESSION object itself. The default is to use a global -list for all acceptors. +corresponding SESSION object itself. The default +is to use a global list for all acceptors. @@ -1384,67 +1477,23 @@     lock - A function which returns a lock that will be used -to prevent concurrent access to sessions. The first argument will be -the acceptor that handles the current request, the second argument is -true if the whole (current) session database is modified. If it is -NIL, only one existing session in the database is modified. - -This function can return NIL which means that sessions or session -databases will be modified without a lock held (for example for -single-threaded environments). The default is to always return a -global lock (ignoring the ACCEPTOR argument) for Lisps that support -threads and NIL otherwise. + A function which returns a lock that will be +used to prevent concurrent access to sessions. The first argument +will be the acceptor that handles the +current request, the second argument is true +if the whole (current) session database is modified. If it +is NIL, only one existing session in the database is +modified. +

    +This function can return NIL which means that sessions or +session databases will be modified without a lock held (for example +for single-threaded environments). The default is to always return a +global lock (ignoring the acceptor argument) for +Lisps that support threads and NIL otherwise. +

         - - - - | - - Removes sessions from the current session database which are too -old - see SESSION-TOO-OLD-P. - - - - - session - - max-time - - - - - - - session - - remote-addr - - - - - - - session - - generalized-boolean - - Returns true if the SESSION object SESSION has not been active in -the last (SESSION-MAX-TIME SESSION) seconds. - - - - - session - - user-agent - - - - - request @@ -1452,16 +1501,31 @@ Tries to get a session identifier from the cookies (or alternatively from the GET parameters) sent by the client. This -identifier is then checked for validity against the REQUEST object -REQUEST. On success the corresponding session object (if not too -old) is returned (and updated). Otherwise NIL is returned. - +identifier is then checked for validity against the REQUEST object +request. On success the corresponding session object (if not too +old) is returned (and updated). Otherwise NIL is returned. +

    A default method is provided and you only need to write your own one if you want to maintain your own sessions. +

         + + session + + string + + Returns a string which can be used to safely +restore the session session if as session has +already been established. This is used as the value stored in the +session cookie or in the corresponding GET parameter. A default +method is provided and there's no reason to change it unless you +want to use your own session objects. + + + Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 21:25:42 UTC (rev 4282) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 22:12:41 UTC (rev 4283) @@ -96,8 +96,8 @@ was sent when this session was created.") (remote-addr :initform (real-remote-addr *request*) :reader session-remote-addr - :documentation "The remote IP address of the client when -this sessions was started as returned by REAL-REMOTE-ADDR.") + :documentation "The remote IP address of the client +when this session was started as returned by REAL-REMOTE-ADDR.") (session-start :initform (get-universal-time) :reader session-start :documentation "The time this session was started.") From bknr at bknr.net Wed Feb 18 23:03:49 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 00:03:49 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4284 Author: edi URL: http://bknr.net/trac/changeset/4284 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp Change set too large, please see URL above From bknr at bknr.net Wed Feb 18 23:30:05 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 00:30:05 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4285 Author: edi URL: http://bknr.net/trac/changeset/4285 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml Change set too large, please see URL above From bknr at bknr.net Wed Feb 18 23:44:44 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 00:44:44 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4286 Author: edi URL: http://bknr.net/trac/changeset/4286 Replies U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 23:30:05 UTC (rev 4285) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-18 23:44:44 UTC (rev 4286) @@ -1060,7 +1060,8 @@ For each incoming request, the acceptor -creates a REQUEST object and makes it available +(in PROCESS-CONNECTION) creates +a REQUEST object and makes it available to handlers via the special variable *REQUEST*. This object contains all relevant information about the request and this section collects the functions @@ -1431,67 +1432,94 @@ +For each incoming request, the acceptor +(in PROCESS-CONNECTION) creates +a REPLY object and makes it available +to handlers via the special variable +*REPLY*. This object contains all relevant +information (except for the content body) about the reply that will be +sent to the client and this section collects the functions which can +be used to query and modify such an object. In all function +where reply is an optional or keyword parameter, +the default is *REPLY*. + +

    +If you need more fine-grained control over the behaviour of reply +objects, you can subclass REPLY and initialize +the REPLY-CLASS +slot of the ACCEPTOR class accordingly. The +acceptor will generate reply objects of the class named by this +slot. +

    + Objects of this class hold all the information about an outgoing reply. They are created automatically by Hunchentoot and can be accessed and modified by the corresponding -handler. - +handler. +

    You should not mess with the slots of these objects directly, but you -can subclass REPLY in order to implement your own behaviour. See the -REPLY-CLASS slot of the ACCEPTOR class. +can subclass REPLY in order to implement your own behaviour. See the +:reply-class initarg +of the ACCEPTOR class. +

         + + The current REPLY object in the context of a request. + + - - + + + name optional reply - result + string - The external format of REPLY which is used for character output. + + HEADER-OUT returns the outgoing http header named by the keyword name if there is one, otherwise NIL. SETF of HEADER-OUT changes the current value of the header named name. If no header named name exists, it is created. For backwards compatibility, name can also be a string in which case the association between a header and its name is case-insensitive. +

    + Note that the header 'Set-Cookie' cannot be queried by HEADER-OUT and must not be set by SETF of HEADER-OUT. + See also HEADERS-OUT*, CONTENT-TYPE*, CONTENT-LENGTH*, COOKIES-OUT*, and COOKIE-OUT. +

     -     +     - - The current REPLY object in the context of a request. - - - - + optional reply - result + alist - The outgoing 'Content-Length' http header of REPLY. + Returns an alist of the outgoing headers associated with the +REPLY object reply. See also HEADER-OUT. - +     - - + optional reply - result + content-length - The outgoing 'Content-Type' http header of REPLY. + The outgoing 'Content-Length' http header of reply. - + + optional reply - result + content-type - Returns an alist of the outgoing cookies associated with the -REPLY object REPLY. + The outgoing 'Content-Type' http header of reply. @@ -1502,44 +1530,45 @@ result - Returns the current value of the outgoing cookie named -NAME. Search is case-sensitive. + Returns the current value of the outgoing cookie named +name. Search is case-sensitive. - - name + + optional reply - result + alist - Returns the current value of the outgoing http header named NAME. -NAME should be a keyword or a string. + Returns an alist of the outgoing cookies associated with the +REPLY object reply. - + - + optional reply - result + return-code - Returns an alist of the outgoing headers associated with the -REPLY object REPLY. + Gets or sets the http return code + of reply. The return code of + each REPLY object is initially set + to +HTTP-OK+. - + - + optional reply - result + external-format - The http return code of REPLY. The return codes Hunchentoot can -handle are defined in specials.lisp. + The external format of reply which is used for character output. From bknr at bknr.net Thu Feb 19 00:20:41 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 01:20:41 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4287 Author: edi URL: http://bknr.net/trac/changeset/4287 Checkpoint U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/request.lisp Change set too large, please see URL above From bknr at bknr.net Thu Feb 19 00:36:53 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 01:36:53 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4288 Author: edi URL: http://bknr.net/trac/changeset/4288 Yawn... U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 00:20:40 UTC (rev 4287) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 00:36:53 UTC (rev 4288) @@ -523,17 +523,6 @@ - - - optional - acceptor - - generalized-boolean - - Whether the current connection to the client is secure. See ACCEPTOR-SSL-P. - - - acceptor @@ -814,6 +803,31 @@ matches the CL-PPCRE regular expression REGEX. + + + path optional content-type + nil + + Sends the file denoted by the pathname designator + path with content type + content-type to the client. Sets the + necessary handlers. In particular the function employs + HANDLE-IF-MODIFIED-SINCE. +

    + If content-type is NIL the + function tries to determine the correct content type from + the file's suffix or falls back + to "application/octet-stream" as a last resort. +

    +

    + Note that this function + calls SEND-HEADERS internally, so after + you've called it, the headers are sent and the return value + of your handler is ignored. +

    +     +     + uri path optional @@ -828,6 +842,7 @@ determine the content type via the file's suffix. + request @@ -1055,19 +1070,43 @@ - - time + + optional - request + result result - Handles the 'If-Modified-Since' header of REQUEST. The date string -is compared to the one generated from the supplied universal time -TIME. + This function can be called by a request handler +at any time to immediately abort handling the request. This works as +if the handler had returned result. See the +source code of REDIRECT for an example. + + time optional request + | + + This function is designed to be used inside + a handler. If the client has sent an + 'If-Modified-Since' header + (see RFC?2616, + section 14.25) and the time specified matches the universal + time + time then the + header +HTTP-NOT-MODIFIED+ with no content + is immediately returned to the client. +

    + Note that for this function to be useful you should usually + send 'Last-Modified' headers back to the client. See the + code + of CREATE-STATIC-FILE-DISPATCHER-AND-HANDLER + for an example. +

    +     +     +     @@ -1799,6 +1838,31 @@     + + stream + + Sends the initial status line and all headers as determined + by the REPLY + object *REPLY*. Returns + a binary + stream to which the body of the reply can be written. Once + this function has been called, further changes + to *REPLY* don't have any effect. + Also, automatic handling of errors (i.e. sending the + corresponding status code to the browser, etc.) is turned + off for this request and functions + like REDIRECT or + to ABORT-REQUEST-HANDLER won't have the + desired effect once the headers are sent. +

    + If your handlers return the full body as a string or as an + array of octets, you should not call this function. + If a handler calls SEND-HEADERS , its + return value is ignored. +

    +     +     + optional @@ -2588,6 +2652,95 @@ + + target key host port protocol add-session-id code + | + + Sends back appropriate headers to redirect the client + to target (a string). +

    + If target is a full URL starting with a + scheme, host, port, + and protocol are ignored. + Otherwise, target should denote the path + part of a URL, protocol must be one of + the keywords :HTTP or :HTTPS, and + the URL to redirect to will be constructed + from host, port, protocol, + and target. +

    +

    + If code is a 3xx?redirection code, it + will be sent as status code. In case of NIL, a + 302?status code will be sent to the client. + If host is not provided, the current host + (see HOST) will be + used. If protocol is the + keyword :HTTPS, the client will be redirected + to a https URL, if it's :HTTP it'll be sent to + a http URL. If both host + and protocol aren't provided, then the + value of protocol will match the current + request. +

    +     +     + + + optional realm + | + + Sends back appropriate headers to require basic HTTP + authentication + (see RFC?2617) + for the realm realm. The default value + for realm is "Hunchentoot". + + + + + + + | + + Adds appropriate headers to completely prevent caching on most browsers. + + + + + + optional + acceptor + + generalized-boolean + + Whether the current connection to the client is secure. See ACCEPTOR-SSL-P. + + + + + return-code + + string + + Returns a reason phrase for the HTTP return code return-code +(which should be an integer) or NIL for return codes Hunchentoot +doesn't know. + + + + + + optional + time + + string + + Generates a time string according to RFC 1123. Default is current time. +This can be used to send a 'Last-Modified' header - see HANDLE-IF-MODIFIED-SINCE. + + + string optional @@ -2625,6 +2778,44 @@ + + object + generalized-boolean + + This function tests whether object is a + non-empty string which is a token according + to RFC + 2068 (i.e. whether it may be used for, say, cookie names). + + + + + pathspec + + result + + Given a pathname designator pathspec returns the MIME type +(as a string) corresponding to the suffix of the file denoted by +pathspec (or NIL). + + + + + + This should be a pathname denoting a directory where temporary + files can be stored. It is used for file + uploads. + + + + + If this variable is not NIL, it should be bound to a stream to +which incoming and outgoing headers will be written for debugging +purposes. + + + + A designator for a function without arguments which is called on a regular basis if *CLEANUP-INTERVAL* is not NIL. The initial value is @@ -2652,155 +2843,7 @@     - - - If this variable is not NIL, it should be bound to a stream to -which incoming and outgoing headers will be written for debugging -purposes. - - - - - - Directory for temporary files created by MAKE-TMP-FILE-NAME. - - - - - - - optional - result - - result - - This function can be called by a request handler at any time to -immediately abort handling the request. This works as if the handler -had returned RESULT. See the source code of REDIRECT for an example. - - - - - - - path - optional - content-type - - result - - A function which acts like a Hunchentoot handler for the file -denoted by PATH. Sends a content type header corresponding to -CONTENT-TYPE or (if that is NIL) tries to determine the content type -via the file's suffix. - - - - - token - - result - - Tests whether TOKEN is a string which is a valid 'token' -according to HTTP/1.1 (RFC 2068). - - - - - - pathspec - - result - - Given a pathname designator PATHSPEC returns the MIME type -(as a string) corresponding to the suffix of the file denoted by -PATHSPEC (or NIL). - - - - - - - result - - Adds appropriate headers to completely prevent caching on most browsers. - - - - - - return-code - - result - - Returns a reason phrase for the HTTP return code RETURN-CODE -(which should be an integer) or NIL for return codes Hunchentoot -doesn't know. - - - - - - target - key - host port protocol add-session-id code - - result - - Redirects the browser to TARGET which should be a string. If -TARGET is a full URL starting with a scheme, HOST, PORT and PROTOCOL -are ignored. Otherwise, TARGET should denote the path part of a URL, -PROTOCOL must be one of the keywords :HTTP or :HTTPS, and the URL to -redirect to will be constructed from HOST, PORT, PROTOCOL, and TARGET. -Adds a session ID if ADD-SESSION-ID is true. If CODE is a 3xx -redirection code, it will be sent as status code. - - - - - - - optional - realm - - result - - Sends back appropriate headers to require basic HTTP authentication -(see RFC 2617) for the realm REALM. - - - - - - optional - time - - result - - Generates a time string according to RFC 1123. Default is current time. - - - - - - - result - - Sends the initial status line and all headers as determined by the -REPLY object *REPLY*. Returns a binary stream to which the body of -the reply can be written. Once this function has been called, further -changes to *REPLY* don't have any effect. Also, automatic handling of -errors (i.e. sending the corresponding status code to the browser, -etc.) is turned off for this request. If your handlers return the -full body as a string or as an array of octets you should NOT call -this function. - - - - - - Hunchentoot comes with a test script which verifies that the example web server responds as expected. This test script uses the From bknr at bknr.net Thu Feb 19 01:11:43 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:11:43 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4289 Author: edi URL: http://bknr.net/trac/changeset/4289 Done (?) U trunk/thirdparty/hunchentoot/CHANGELOG U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-19 00:36:53 UTC (rev 4288) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-19 01:11:43 UTC (rev 4289) @@ -1,5 +1,5 @@ Version 1.0.0 -2009-02-10 +2009-02-19 Architectural redesign (thanks to Hans H?bner) Lots of small fixes and improvement, too many to enumerate here Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 00:36:53 UTC (rev 4288) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 01:11:43 UTC (rev 4289) @@ -443,7 +443,8 @@ These are readers for various slots of ACCEPTOR objects (and some of them obviously only make sense for SSL-ACCEPTOR objects). See the docstrings of -these slots for more information. +these slots for more information and note that there are corresponding +initargs for all of them. @@ -513,16 +514,11 @@ These are accessors for various slots of ACCEPTOR -objects. See the docstrings of these slots for more information. +objects. See the docstrings of these slots for more information and +note that there are corresponding initargs for all of them. - - The current ACCEPTOR object while in the context of a request. - - - - acceptor @@ -765,66 +761,117 @@ - + +The main job of PROCESS-REQUEST is to select and +call a function which handles the request, i.e. which looks at the +data the client has sent and prepares an appropriate reply to send +back. This is implemented as follows: +

    +Each acceptor has a request +dispatcher which is a unary function that accepts +a REQUEST object. This function is called by +PROCESS-REQUEST. The idea is that this function +looks at the request object and depending on its contents decides to +call another function which "does the work". This "other" function is +by convention called a request +handler. (Obviously, this is really only a convention as +process-request doesn't "know" what the request dispatcher does. You +could as well say that the request dispatcher and the request handler +have the same job.) +

    +

    +The default behaviour, unless you implement your own request +dispatcher, is that Hunchentoot walks through the list +*dispatch-table* which consists of dispatch functions. Each +of these functions accepts the request object as its only argument and +either returns a request handler to handle the request +or NIL which means that the next dispatcher in the list +will be tried. If all dispatch functions return NIL, the +return code ++HTTP-NOT-FOUND+ will be sent to the client. +

    +

    +All functions and variables in this section are related to the +standard request dispatch mechanism described above and are +meaningless if you're using your own request dispatcher. +

    +

    +Request handlers do their work by modifying +the reply object if necessary and by eventually +returning the response body in the form of a string or a binary +sequence. As an alternative, they can also +call SEND-HEADERS and write directly to a stream. +

    - - uri-prefix base-path - optional - content-type - - result - - Creates and returns a dispatch function which will dispatch to a -handler function which emits the file relative to BASE-PATH that is -denoted by the URI of the request relative to URI-PREFIX. URI-PREFIX -must be a string ending with a slash, BASE-PATH must be a pathname -designator for an existing directory. If CONTENT-TYPE is not NIL, -it'll be the content type used for all files in the folder. + + A global list of dispatch functions. The + initial value is a list consisting of the two + symbols DISPATCH-EASY-HANDLERS + and DEFAULT-DISPATCHER. - - - prefix handler + + + + request result - Creates a request dispatch function which will dispatch to the -function denoted by HANDLER if the file name of the current request -starts with the string PREFIX. + Default dispatch function which handles every request with the +function stored in *DEFAULT-HANDLER*. - - regex handler - - result - - Creates a request dispatch function which will dispatch to the -function denoted by HANDLER if the file name of the current request -matches the CL-PPCRE regular expression REGEX. + + + The name of the function which is always returned by +DEFAULT-DISPATCHER. - + - - path optional content-type - nil + + prefix handler + dispatch-fn - Sends the file denoted by the pathname designator - path with content type - content-type to the client. Sets the - necessary handlers. In particular the function employs - HANDLE-IF-MODIFIED-SINCE. + A convenience function which will return a dispatcher that + returns handler whenever the path part of + the request URI starts with the + string prefix. + + + + + regex handler + dispatch-fn + + A convenience function which will return a dispatcher that + returns handler whenever the path part of + the request URI matches + the CL-PPCRE regular + expression regex (which can be a string, an + s-expression, or a scanner). + + + + + uri-prefix base-path optional content-type + dispatch-fn + + Creates and returns a dispatch function which will dispatch to + a handler function which emits the file relative + to base-path that is denoted by the URI of + the request relative + to uri-prefix. uri-prefix + must be a string ending with a + slash, base-path must be a pathname + designator for an existing directory. + Uses HANDLE-STATIC-FILE internally.

    - If content-type is NIL the - function tries to determine the correct content type from - the file's suffix or falls back - to "application/octet-stream" as a last resort. + If content-type is not + NIL, it will be used as a the content type for + all files in the folder. Otherwise (which is the default) + the content type of each file will be + determined as usual.

    -

    - Note that this function - calls SEND-HEADERS internally, so after - you've called it, the headers are sent and the return value - of your handler is ignored. -

    @@ -843,15 +890,6 @@     - - request - - result - - Default dispatch function which handles every request with the -function stored in *DEFAULT-HANDLER*. - - description lambda-list [[declaration* | documentation]] form* @@ -1050,65 +1088,14 @@ result This is a dispatcher which returns the appropriate handler -defined with DEFINE-EASY-HANDLER, if there is one. +defined with DEFINE-EASY-HANDLER, if there is one. - - The name of the function which is always returned by -DEFAULT-DISPATCHER. - - - - A global list of dispatch functions. - - -     - - - - - optional - result - - result - - This function can be called by a request handler -at any time to immediately abort handling the request. This works as -if the handler had returned result. See the -source code of REDIRECT for an example. - - - - - time optional request - | - - This function is designed to be used inside - a handler. If the client has sent an - 'If-Modified-Since' header - (see RFC?2616, - section 14.25) and the time specified matches the universal - time - time then the - header +HTTP-NOT-MODIFIED+ with no content - is immediately returned to the client. -

    - Note that for this function to be useful you should usually - send 'Last-Modified' headers back to the client. See the - code - of CREATE-STATIC-FILE-DISPATCHER-AND-HANDLER - for an example. -

    -     -     - -     - For each incoming request, the acceptor @@ -2434,7 +2421,7 @@ - Outgoing cookies are stored in the request's REPLY + Outgoing cookies are stored in the request's REPLY object (see COOKIE-OUT and COOKIES-OUT*). They are CLOS objects defined like this: @@ -2599,26 +2586,9 @@ - - Superclass for all conditions related to Hunchentoot. - - +This section describes how Hunchentoot deals with exceptional +situations. See also the secion about logging. - - Superclass for all errors related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. - - - - - Signalled if a function was called with incosistent or illegal parameters. A subclass of HUNCHENTOOT-ERROR. - - - - - Superclass for all warnings related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. - - - Whether Lisp errors should be shown in HTML output. @@ -2648,10 +2618,94 @@ + + Superclass for all conditions related to Hunchentoot. + + + + + Superclass for all errors related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. + + + + + Signalled if a function was called with incosistent or illegal parameters. A subclass of HUNCHENTOOT-ERROR. + + + + + Superclass for all warnings related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. + + + + Various functions and variables which didn't fit into one of the + other categories. + + + + optional + result + + result + + This function can be called by a request handler +at any time to immediately abort handling the request. This works as +if the handler had returned result. See the +source code of REDIRECT for an example. + + + + + time optional request + | + + This function is designed to be used inside + a handler. If the client has sent an + 'If-Modified-Since' header + (see RFC?2616, + section 14.25) and the time specified matches the universal + time + time then the + header +HTTP-NOT-MODIFIED+ with no content + is immediately returned to the client. +

    + Note that for this function to be useful you should usually + send 'Last-Modified' headers back to the client. See the + code + of CREATE-STATIC-FILE-DISPATCHER-AND-HANDLER + for an example. +

    +     +     + + + path optional content-type + nil + + Sends the file denoted by the pathname designator + path with content type + content-type to the client. Sets the + necessary handlers. In particular the function employs + HANDLE-IF-MODIFIED-SINCE. +

    + If content-type is NIL the + function tries to determine the correct content type from + the file's suffix or falls back + to "application/octet-stream" as a last resort. +

    +

    + Note that this function + calls SEND-HEADERS internally, so after + you've called it, the headers are sent and the return value + of your handler is ignored. +

    +     +     + target key host port protocol add-session-id code | From bknr at bknr.net Thu Feb 19 01:12:24 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:12:24 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/CHANGELOG Message-ID: Revision: 4290 Author: edi URL: http://bknr.net/trac/changeset/4290 And more U trunk/thirdparty/hunchentoot/CHANGELOG Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-19 01:11:43 UTC (rev 4289) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-19 01:12:24 UTC (rev 4290) @@ -1,7 +1,7 @@ Version 1.0.0 2009-02-19 -Architectural redesign (thanks to Hans H?bner) -Lots of small fixes and improvement, too many to enumerate here +Complete architectural redesign (together with Hans H?bner) +Lots of small fixes and improvements, too many to enumerate here Version 0.15.6 2008-04-09 From bknr at bknr.net Thu Feb 19 01:18:09 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:18:09 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/CHANGELOG.txt Message-ID: Revision: 4291 Author: edi URL: http://bknr.net/trac/changeset/4291 Date U trunk/thirdparty/drakma/CHANGELOG.txt Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-19 01:12:24 UTC (rev 4290) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-02-19 01:18:09 UTC (rev 4291) @@ -1,5 +1,5 @@ Version 1.0.0 -2009-02-09 +2009-02-19 Use the new ("binary") version of Chunga Added conditions types Some performance improvements From bknr at bknr.net Thu Feb 19 01:18:40 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:18:40 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/chunga/CHANGELOG.txt Message-ID: Revision: 4292 Author: edi URL: http://bknr.net/trac/changeset/4292 Date U trunk/thirdparty/chunga/CHANGELOG.txt Modified: trunk/thirdparty/chunga/CHANGELOG.txt =================================================================== --- trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-19 01:18:09 UTC (rev 4291) +++ trunk/thirdparty/chunga/CHANGELOG.txt 2009-02-19 01:18:39 UTC (rev 4292) @@ -1,5 +1,5 @@ Version 1.0.0 -2009-02-10 +2009-02-19 Switched to binary streams underneath and got rid of FLEXI-STREAMS dependency Added conditions Exported (an improved version of) AS-KEYWORD From bknr at bknr.net Thu Feb 19 01:19:50 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:19:50 +0100 Subject: [bknr-cvs] edi changed tags/thirdparty/hunchentoot-1.0.0/ Message-ID: Revision: 4293 Author: edi URL: http://bknr.net/trac/changeset/4293 Tag release A tags/thirdparty/hunchentoot-1.0.0/ Copied: tags/thirdparty/hunchentoot-1.0.0 (from rev 4292, trunk/thirdparty/hunchentoot) From bknr at bknr.net Thu Feb 19 01:20:15 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:20:15 +0100 Subject: [bknr-cvs] edi changed tags/thirdparty/drakma-1.0.0/ Message-ID: Revision: 4294 Author: edi URL: http://bknr.net/trac/changeset/4294 Tag release of Drakma 1.0.0 A tags/thirdparty/drakma-1.0.0/ Copied: tags/thirdparty/drakma-1.0.0 (from rev 4293, trunk/thirdparty/drakma) From bknr at bknr.net Thu Feb 19 01:20:33 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:20:33 +0100 Subject: [bknr-cvs] edi changed tags/thirdparty/chunga-1.0.0/ Message-ID: Revision: 4295 Author: edi URL: http://bknr.net/trac/changeset/4295 Tag release of Chunga 1.0.0 A tags/thirdparty/chunga-1.0.0/ Copied: tags/thirdparty/chunga-1.0.0 (from rev 4294, trunk/thirdparty/chunga) From bknr at bknr.net Thu Feb 19 01:29:37 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:29:37 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/check-doc.lisp Message-ID: Revision: 4296 Author: edi URL: http://bknr.net/trac/changeset/4296 Not for release D trunk/thirdparty/hunchentoot/doc/check-doc.lisp Deleted: trunk/thirdparty/hunchentoot/doc/check-doc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/doc/check-doc.lisp 2009-02-19 01:20:33 UTC (rev 4295) +++ trunk/thirdparty/hunchentoot/doc/check-doc.lisp 2009-02-19 01:29:37 UTC (rev 4296) @@ -1,129 +0,0 @@ - -(defun do-documented-names% (thunk) - (labels ((find-documentation (node) - (when (listp node) - (let* ((symbol-type (cxml-xmls:node-name node)) - (symbol-name (cadr (assoc "name" (cxml-xmls:node-attrs node) :test #'equal))) - (symbol-name (and symbol-name (string-upcase symbol-name)))) - (when (find symbol-type '("function" "reader" "accessor" "constant" "special-variable" "symbol") - :test #'equal) - (funcall thunk symbol-name symbol-type node)) - (mapc #'find-documentation (cxml-xmls:node-children node)))))) - (find-documentation (cxml:parse-file "index.xml" (cxml-xmls:make-xmls-builder)))) - nil) - -(defmacro do-documented-names ((symbol-name-var - &optional - (symbol-type-var (gensym) symbol-type-var-p) - (node-var (gensym) node-var-p)) - &body body) - `(do-documented-names% (lambda (,symbol-name-var ,symbol-type-var ,node-var) - (declare (ignorable - ,(unless symbol-type-var-p - `,symbol-type-var) - ,(unless node-var-p - `,node-var))) - (block nil - , at body)))) - -(defun documented-names () - "Returns a list of strings, the symbols that are documented in index.xml" - (let (names) - (do-documented-names (symbol-name) - (pushnew symbol-name names :test #'string-equal)) - names)) - -(defun arglist-from-xml-lambda-list (nodes) - (format nil "(~:@(~A~))" - (string-trim " " - (apply #'concatenate 'string - (mapcar (lambda (node) - (cond - ((stringp node) (cl-ppcre:regex-replace-all "[ \\r\\n]+" node " ")) - ((equal "lkw" (cxml-xmls:node-name node)) - (format nil "&~A" (car (cxml-xmls:node-children node)))) - (t - (error "unexpected node ~A in lambda-list documentation")))) - nodes))))) - -(defun cleanup-arglist (arglist) - "Remove &rest argument from the given lambda list if there are -arguments following the &rest argument." - (do ((rest arglist (cdr rest)) - result) - ((null rest) (nreverse result)) - (if (and (eq (car rest) '&rest) - (cddr rest)) - (setf rest (cdr rest)) - (push (car rest) result)))) - -(defun check-function-argument-documentation () - (do-documented-names (symbol-name symbol-type node) - (when (find symbol-type '("function" "reader" "accessor") :test #'equal) - (handler-case - (fdefinition (find-symbol symbol-name :hunchentoot)) - (error (e) - (declare (ignore e)) - (return))) - (let* ((real-arglist (cleanup-arglist (swank::arglist (find-symbol symbol-name :hunchentoot)))) - (real-arglist-string (princ-to-string - (or real-arglist - "()"))) - (documented-arglist-string (arglist-from-xml-lambda-list - (cxml-xmls:node-children - (find-if (lambda (node) - (and (listp node) - (equal "lambda-list" (cxml-xmls:node-name node)))) - (cxml-xmls:node-children node)))))) - (when (and (= 1 (length real-arglist)) - (cl-ppcre:scan "(\\S+)" documented-arglist-string)) - ;; For single-argument functions, do not report argument - ;; name mismatches as the real argument name is often - ;; generated by the compiler in reader/writer/accessor slot - ;; options. - (return)) - (unless (equal real-arglist-string documented-arglist-string) - (format t "documented arglist for ~A ~A~% ~A~%deviates from real arglist~% ~A~%~%" - symbol-type symbol-name documented-arglist-string real-arglist-string)))))) - -(defun node-text (node) - (let (strings) - (labels ((recurse (node) - (if (stringp node) - (push node strings) - (mapc #'recurse (cxml-xmls:node-children node))))) - (recurse node) - (apply #'concatenate 'string (nreverse strings))))) - -(defun clean-string (string) - (string-trim " " (cl-ppcre:regex-replace-all "[\\r\\n]+\\s*" string " "))) - -(defun dump-docstring-and-description () - (do-documented-names (symbol-name symbol-type node) - (when (find symbol-type '("function" "accessor") :test #'equal) - (let ((docstring (clean-string (documentation (find-symbol symbol-name :hunchentoot) 'function))) - (documentation-string (clean-string - (node-text (find "description" (remove-if-not #'listp (cxml-xmls:node-children node)) - :key #'cxml-xmls:node-name :test #'equal))))) - (format t "----~%~A:~%~A~%~%~A~%~%" symbol-name - docstring - documentation-string))))) - -(defun exported-names () - "Return list of strings, the symbols that are exported from the Hunchentoot package" - (let (names) - (do-external-symbols (symbol :hunchentoot) - (pushnew (symbol-name symbol) names)) - names)) - -(defun check-doc () - (format t "---------------------~%") - (let* ((documented (documented-names)) - (exported (exported-names)) - (not-exported (sort (set-difference documented exported :test #'equal) #'string-lessp)) - (not-documented (sort (set-difference exported documented :test #'equal) #'string-lessp))) - (when not-exported - (format t "Documented, but not exported: ~{~& ~A~}~%~%" not-exported)) - (when not-documented - (format t "Exported, but not documented: ~{~& ~A~}~%~%" not-documented))) - (check-function-argument-documentation)) \ No newline at end of file From bknr at bknr.net Thu Feb 19 01:29:55 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:29:55 +0100 Subject: [bknr-cvs] edi changed tags/thirdparty/hunchentoot-1.0.0/ Message-ID: Revision: 4297 Author: edi URL: http://bknr.net/trac/changeset/4297 Revert D tags/thirdparty/hunchentoot-1.0.0/ From bknr at bknr.net Thu Feb 19 01:30:14 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 02:30:14 +0100 Subject: [bknr-cvs] edi changed tags/thirdparty/hunchentoot-1.0.0/ Message-ID: Revision: 4298 Author: edi URL: http://bknr.net/trac/changeset/4298 Tag again A tags/thirdparty/hunchentoot-1.0.0/ Copied: tags/thirdparty/hunchentoot-1.0.0 (from rev 4297, trunk/thirdparty/hunchentoot) From bknr at bknr.net Thu Feb 19 02:12:21 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 03:12:21 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/ Message-ID: Revision: 4299 Author: edi URL: http://bknr.net/trac/changeset/4299 Cosmetic surgery U trunk/thirdparty/hunchentoot/doc/clixdoc.xsl U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/clixdoc.xsl =================================================================== --- trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-19 01:30:14 UTC (rev 4298) +++ trunk/thirdparty/hunchentoot/doc/clixdoc.xsl 2009-02-19 02:12:21 UTC (rev 4299) @@ -398,6 +398,13 @@ Reader + + + Generic reader + Specialized reader + Reader + + Generic readers @@ -419,6 +426,13 @@ Writer + + + Generic accessor + Specialized accessor + Accessor + + Generic accessor Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 01:30:14 UTC (rev 4298) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 02:12:21 UTC (rev 4299) @@ -390,49 +390,49 @@ - + acceptor address - + acceptor port - + acceptor read-timeout - + ssl-acceptor ssl-certificate-file - + ssl-acceptor ssl-privatekey-file - + ssl-acceptor ssl-privatekey-password - + acceptor write-timeout @@ -449,63 +449,63 @@ - + acceptor access-logger - + acceptor request-dispatcher - + acceptor input-chunking-p - + acceptor message-logger - + acceptor name - + acceptor output-chunking-p - + acceptor persistent-connections-p - + acceptor reply-class - + acceptor request-class @@ -1588,21 +1588,21 @@ - + request cookies - + request get-parameters - + name request result @@ -1611,70 +1611,70 @@ - + request headers - + request post-parameters - + request query-string - + request address - + request port - + request acceptor - + request method - + request uri - + request protocol - + request result @@ -1919,21 +1919,21 @@ - + reply content-length - + reply content-type - + reply headers-out @@ -1951,21 +1951,21 @@ - + reply result - + reply result - + reply result From bknr at bknr.net Thu Feb 19 10:34:09 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 11:34:09 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4300 Author: edi URL: http://bknr.net/trac/changeset/4300 Fix dependency U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 02:12:21 UTC (rev 4299) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 10:34:09 UTC (rev 4300) @@ -95,7 +95,7 @@
  • and my own FLEXI-STREAMS (0.12.0 or higher), - Chunga (0.5.0 or + Chunga (1.0.0 or higher), and CL-PPCRE (plus CL-WHO for the example code and Drakma for the tests.). From bknr at bknr.net Thu Feb 19 14:18:41 2009 From: bknr at bknr.net (BKNR Commits) Date: Thu, 19 Feb 2009 15:18:41 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/doc/index.xml Message-ID: Revision: 4301 Author: edi URL: http://bknr.net/trac/changeset/4301 Minimal change for parsing U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 10:34:09 UTC (rev 4300) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 14:18:41 UTC (rev 4301) @@ -2,8 +2,7 @@ - HUNCHENTOOT - The Common Lisp web server formerly known as TBNL - + HUNCHENTOOT - The Common Lisp web server formerly known as TBNL A fully-featured web server written in Common Lisp offering things like HTTP/1.1 chunking, persistent connections, and SSL. Includes From bknr at bknr.net Fri Feb 20 07:26:38 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 20 Feb 2009 08:26:38 +0100 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4302 Author: edi URL: http://bknr.net/trac/changeset/4302 SSL key passwords for the rest U trunk/thirdparty/hunchentoot/CHANGELOG U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/ssl.lisp Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-19 14:18:41 UTC (rev 4301) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-20 07:26:37 UTC (rev 4302) @@ -1,3 +1,5 @@ +Enable SSL key passwords for Lisps other than LW (Vsevolod) + Version 1.0.0 2009-02-19 Complete architectural redesign (together with Hans H?bner) Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-19 14:18:41 UTC (rev 4301) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-20 07:26:37 UTC (rev 4302) @@ -353,10 +353,10 @@ required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for pathname designators denoting the certificate file and the key file in PEM format. On LispWorks, you can have both in one file in which case -the second initarg is optional. On LispWorks, you can also use the -:SSL-PRIVATEKEY-PASSWORD initarg to provide a password (as a string) -for the key file (or NIL, the default, for no password). On other -Lisps, the key file must not be password-protected. +the second initarg is optional. You can also use the +:SSL-PRIVATEKEY-PASSWORD initarg to provide a password +(as a string) for the key file (or NIL, the default, for +no password).

    The default port for SSL-ACCEPTOR instances is 443 instead of 80

    Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-19 14:18:41 UTC (rev 4301) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-20 07:26:37 UTC (rev 4302) @@ -39,7 +39,6 @@ :documentation "A pathname designator for a private key file in PEM format, or \(only on LispWorks) NIL if the certificate file contains the private key.") - #+:lispworks (ssl-privatekey-password :initform nil :initarg :ssl-privatekey-password :reader acceptor-ssl-privatekey-password @@ -52,10 +51,9 @@ required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for pathname designators denoting the certificate file and the key file in PEM format. On LispWorks, you can have both in one file in which case -the second initarg is optional. On LispWorks, you can also use the +the second initarg is optional. You can also use the :SSL-PRIVATEKEY-PASSWORD initarg to provide a password \(as a string) -for the key file \(or NIL, the default, for no password). On other -Lisps, the key file must not be password-protected. +for the key file \(or NIL, the default, for no password). The default port for SSL-ACCEPTOR instances is 443 instead of 80")) @@ -85,11 +83,12 @@ (call-next-method acceptor (cl+ssl:make-ssl-server-stream stream :certificate (acceptor-ssl-certificate-file acceptor) - :key (acceptor-ssl-privatekey-file acceptor)))) + :key (acceptor-ssl-privatekey-file acceptor) + :password (acceptor-ssl-privatekey-password acceptor)))) ;; LispWorks implementation -#+lispworks +#+:lispworks (defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the stream using the certificate file CERTIFICATE-FILE and the private key From bknr at bknr.net Fri Feb 20 11:05:20 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 20 Feb 2009 12:05:20 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/acceptor.lisp Message-ID: Revision: 4303 Author: hans URL: http://bknr.net/trac/changeset/4303 Make HUNCHENTOOT:STOP work again. U trunk/thirdparty/hunchentoot/acceptor.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-20 07:26:37 UTC (rev 4302) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-20 11:05:20 UTC (rev 4303) @@ -114,7 +114,8 @@ matter what kind of taskmaster you are using this will always be a new process different from the one where START was called.") #-:lispworks - (listen-socket :accessor acceptor-listen-socket + (listen-socket :initform nil + :accessor acceptor-listen-socket :documentation "The socket listening for incoming connections.") (acceptor-shutdown-p :initform nil @@ -249,6 +250,8 @@ (shutdown (acceptor-taskmaster acceptor)) #-:lispworks (usocket:socket-close (acceptor-listen-socket acceptor)) + #-:lispworks + (setf (acceptor-listen-socket acceptor) nil) acceptor) (defmethod initialize-connection-stream ((acceptor acceptor) stream) @@ -347,6 +350,8 @@ #-:lispworks (defmethod start-listening ((acceptor acceptor)) + (when (acceptor-listen-socket acceptor) + (hunchentoot-error "acceptor ~A is already listening" acceptor)) (setf (acceptor-listen-socket acceptor) (usocket:socket-listen (or (acceptor-address acceptor) usocket:*wildcard-host*) @@ -361,7 +366,7 @@ (loop (when (acceptor-shutdown-p acceptor) (return)) - (when (usocket:wait-for-input listener :timeout +new-connection-wait-time+) + (when (usocket:wait-for-input listener :ready-only t :timeout +new-connection-wait-time+) (handler-case (when-let (client-connection (usocket:socket-accept listener)) (set-timeouts client-connection From bknr at bknr.net Fri Feb 20 13:25:57 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 20 Feb 2009 14:25:57 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/trivial-backtrace/ Message-ID: Revision: 4304 Author: hans URL: http://bknr.net/trac/changeset/4304 Add trivial-backtrace from upstream darcs A trunk/thirdparty/trivial-backtrace/ A trunk/thirdparty/trivial-backtrace/COPYING A trunk/thirdparty/trivial-backtrace/_darcs/ A trunk/thirdparty/trivial-backtrace/_darcs/checkpoints/ A trunk/thirdparty/trivial-backtrace/_darcs/inventories/ A trunk/thirdparty/trivial-backtrace/_darcs/inventories/20080607234139-3cc5d-ec9301498e9c18a87f6ee9df7eb3b9d41cd0e7b3.gz A trunk/thirdparty/trivial-backtrace/_darcs/inventory A trunk/thirdparty/trivial-backtrace/_darcs/patches/ A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080531025003-3cc5d-dd58f0b0dc84bd47b3040870628b878ebbcb7038.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080601071443-3cc5d-5d1eb8567287255770637861785baaaba0743929.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080602164743-3cc5d-e08f6176e963569296585c631c4a7b46cf0c7bee.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080603084421-3cc5d-a1ddb2ab2247c204ee9e33782ff1fa4e1fee5a0d.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080605170745-3cc5d-ed321b9e85a8bd0be3c856a1a44bf8fe252f4aa8.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080605170902-3cc5d-b6dc26f585fc9443364d5ef43b9167c4aebf8250.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080605170929-3cc5d-fa6731e73aacb8151c9d3823b9786ffd0a1c97f2.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080605170938-3cc5d-851ab33276852127681f6c1126be58f652f3556a.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080607234028-3cc5d-07052c87db8e58350029994adefdcc6d89ee22e6.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080607234043-3cc5d-79033b0b320e11a45a587c9cc3864c9504640fd2.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080607234109-3cc5d-adedaaf69bbccfcd901b0422981eef7137ba51d1.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080607234129-3cc5d-7dc59c85d458f4cfe1795746114ebf7a56826e08.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080607234139-3cc5d-ec9301498e9c18a87f6ee9df7eb3b9d41cd0e7b3.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080610130319-3cc5d-8e0cc8aa2c5a9307f27beb34a1b8464a60e27192.gz A trunk/thirdparty/trivial-backtrace/_darcs/patches/20080621023419-3cc5d-55e22e607d77e49ffe527580eac0a9f9270c78a0.gz A trunk/thirdparty/trivial-backtrace/_darcs/prefs/ A trunk/thirdparty/trivial-backtrace/_darcs/prefs/binaries A trunk/thirdparty/trivial-backtrace/_darcs/prefs/boring A trunk/thirdparty/trivial-backtrace/_darcs/prefs/defaultrepo A trunk/thirdparty/trivial-backtrace/_darcs/prefs/motd A trunk/thirdparty/trivial-backtrace/_darcs/prefs/repos A trunk/thirdparty/trivial-backtrace/_darcs/pristine/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/COPYING A trunk/thirdparty/trivial-backtrace/_darcs/pristine/dev/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/dev/backtrace.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/dev/mucking.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/dev/packages.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/dev/utilities.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/lift-standard.config A trunk/thirdparty/trivial-backtrace/_darcs/pristine/test/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/test/packages.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/test/test-setup.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/test/tests.lisp A trunk/thirdparty/trivial-backtrace/_darcs/pristine/trivial-backtrace-test.asd A trunk/thirdparty/trivial-backtrace/_darcs/pristine/trivial-backtrace.asd A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/index.md A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/resources/ A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/resources/footer.md A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/resources/header.md A trunk/thirdparty/trivial-backtrace/_darcs/pristine/website/source/resources/navigation.md A trunk/thirdparty/trivial-backtrace/dev/ A trunk/thirdparty/trivial-backtrace/dev/backtrace.lisp A trunk/thirdparty/trivial-backtrace/dev/mucking.lisp A trunk/thirdparty/trivial-backtrace/dev/packages.lisp A trunk/thirdparty/trivial-backtrace/dev/utilities.lisp A trunk/thirdparty/trivial-backtrace/lift-standard.config A trunk/thirdparty/trivial-backtrace/test/ A trunk/thirdparty/trivial-backtrace/test/packages.lisp A trunk/thirdparty/trivial-backtrace/test/test-setup.lisp A trunk/thirdparty/trivial-backtrace/test/tests.lisp A trunk/thirdparty/trivial-backtrace/trivial-backtrace-test.asd A trunk/thirdparty/trivial-backtrace/trivial-backtrace.asd A trunk/thirdparty/trivial-backtrace/website/ A trunk/thirdparty/trivial-backtrace/website/source/ A trunk/thirdparty/trivial-backtrace/website/source/index.md A trunk/thirdparty/trivial-backtrace/website/source/resources/ A trunk/thirdparty/trivial-backtrace/website/source/resources/footer.md A trunk/thirdparty/trivial-backtrace/website/source/resources/header.md A trunk/thirdparty/trivial-backtrace/website/source/resources/navigation.md Change set too large, please see URL above From bknr at bknr.net Fri Feb 20 13:27:40 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 20 Feb 2009 14:27:40 +0100 Subject: [bknr-cvs] hans changed ediware/ Message-ID: Revision: 4305 Author: hans URL: http://bknr.net/trac/changeset/4305 import trivial-backtrace _U ediware/ Property changes on: ediware ___________________________________________________________________ Name: svn:externals - bordeaux-threads svn://bknr.net/svn/trunk/thirdparty/bordeaux-threads_0.4.0 cffi svn://bknr.net/svn/trunk/thirdparty/cffi alexandria svn://bknr.net/svn/trunk/thirdparty/alexandria babel svn://bknr.net/svn/trunk/thirdparty/babel chunga svn://bknr.net/svn/trunk/thirdparty/chunga trivial-features svn://bknr.net/svn/trunk/thirdparty/trivial-features cl+ssl svn://bknr.net/svn/trunk/thirdparty/cl+ssl cl-base64 svn://bknr.net/svn/trunk/thirdparty/cl-base64-3.3.2 cl-fad svn://bknr.net/svn/trunk/thirdparty/cl-fad-0.6.2 cl-ppcre svn://bknr.net/svn/trunk/thirdparty/cl-ppcre cl-interpol svn://bknr.net/svn/trunk/thirdparty/cl-interpol cl-unicode svn://bknr.net/svn/trunk/thirdparty/cl-unicode cl-webdav svn://bknr.net/svn/trunk/thirdparty/cl-webdav cl-who svn://bknr.net/svn/trunk/thirdparty/cl-who-0.11.0 drakma svn://bknr.net/svn/trunk/thirdparty/drakma flexi-streams svn://bknr.net/svn/trunk/thirdparty/flexi-streams hunchentoot svn://bknr.net/svn/trunk/thirdparty/hunchentoot md5 svn://bknr.net/svn/trunk/thirdparty/md5-1.8.5 puri svn://bknr.net/svn/trunk/thirdparty/puri-1.5.1 rfc2388 svn://bknr.net/svn/trunk/thirdparty/rfc2388 split-sequence svn://bknr.net/svn/trunk/thirdparty/split-sequence trivial-gray-streams svn://bknr.net/svn/trunk/thirdparty/trivial-gray-streams url-rewrite svn://bknr.net/svn/trunk/thirdparty/url-rewrite-0.1.1 usocket -r489 svn://common-lisp.net/project/usocket/svn/usocket/trunk + alexandria svn://bknr.net/svn/trunk/thirdparty/alexandria babel svn://bknr.net/svn/trunk/thirdparty/babel bordeaux-threads svn://bknr.net/svn/trunk/thirdparty/bordeaux-threads_0.4.0 cffi svn://bknr.net/svn/trunk/thirdparty/cffi chunga svn://bknr.net/svn/trunk/thirdparty/chunga cl+ssl svn://bknr.net/svn/trunk/thirdparty/cl+ssl cl-base64 svn://bknr.net/svn/trunk/thirdparty/cl-base64-3.3.2 cl-fad svn://bknr.net/svn/trunk/thirdparty/cl-fad-0.6.2 cl-interpol svn://bknr.net/svn/trunk/thirdparty/cl-interpol cl-ppcre svn://bknr.net/svn/trunk/thirdparty/cl-ppcre cl-unicode svn://bknr.net/svn/trunk/thirdparty/cl-unicode cl-webdav svn://bknr.net/svn/trunk/thirdparty/cl-webdav cl-who svn://bknr.net/svn/trunk/thirdparty/cl-who-0.11.0 drakma svn://bknr.net/svn/trunk/thirdparty/drakma flexi-streams svn://bknr.net/svn/trunk/thirdparty/flexi-streams hunchentoot svn://bknr.net/svn/trunk/thirdparty/hunchentoot md5 svn://bknr.net/svn/trunk/thirdparty/md5-1.8.5 puri svn://bknr.net/svn/trunk/thirdparty/puri-1.5.1 rfc2388 svn://bknr.net/svn/trunk/thirdparty/rfc2388 split-sequence svn://bknr.net/svn/trunk/thirdparty/split-sequence trivial-backtrace svn://bknr.net/svn/trunk/thirdparty/trivial-backtrace trivial-features svn://bknr.net/svn/trunk/thirdparty/trivial-features trivial-gray-streams svn://bknr.net/svn/trunk/thirdparty/trivial-gray-streams url-rewrite svn://bknr.net/svn/trunk/thirdparty/url-rewrite-0.1.1 usocket svn://common-lisp.net/project/usocket/svn/usocket/trunk From bknr at bknr.net Fri Feb 20 13:28:45 2009 From: bknr at bknr.net (BKNR Commits) Date: Fri, 20 Feb 2009 14:28:45 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/CHANGELOG Message-ID: Revision: 4306 Author: hans URL: http://bknr.net/trac/changeset/4306 Add changelog entry. U trunk/thirdparty/hunchentoot/CHANGELOG Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-20 13:27:40 UTC (rev 4305) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2009-02-20 13:28:45 UTC (rev 4306) @@ -1,3 +1,4 @@ +Fix STOP by supplying the :READY-ONLY keyword to USOCKET:WAIT-FOR-INPUT Enable SSL key passwords for Lisps other than LW (Vsevolod) Version 1.0.0 From bknr at bknr.net Mon Feb 23 11:25:26 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 12:25:26 +0100 Subject: [bknr-cvs] hans changed trunk/projects/lisp-ecoop/src/ Message-ID: Revision: 4307 Author: hans URL: http://bknr.net/trac/changeset/4307 ELW 2009 changes, port over to Hunchentoot 1.0.0 U trunk/projects/lisp-ecoop/src/handlers.lisp U trunk/projects/lisp-ecoop/src/init.lisp U trunk/projects/lisp-ecoop/src/participant.lisp U trunk/projects/lisp-ecoop/src/webserver.lisp Modified: trunk/projects/lisp-ecoop/src/handlers.lisp =================================================================== --- trunk/projects/lisp-ecoop/src/handlers.lisp 2009-02-20 13:28:45 UTC (rev 4306) +++ trunk/projects/lisp-ecoop/src/handlers.lisp 2009-02-23 11:25:25 UTC (rev 4307) @@ -39,7 +39,7 @@ (defmethod handle-object ((handler pdf-handler) (document document)) (let ((pdf (file-contents (blob-pathname document)))) (with-http-response (:content-type "application/pdf") - (setf (content-length) (length pdf)) + (setf (content-length*) (length pdf)) (let ((stream (hunchentoot:send-headers))) (write-sequence pdf stream) (finish-output stream))))) Modified: trunk/projects/lisp-ecoop/src/init.lisp =================================================================== --- trunk/projects/lisp-ecoop/src/init.lisp 2009-02-20 13:28:45 UTC (rev 4306) +++ trunk/projects/lisp-ecoop/src/init.lisp 2009-02-23 11:25:25 UTC (rev 4307) @@ -17,4 +17,4 @@ (publish-lisp-ecoop) - (start-webserver)) + (start-webserver :start-frontend nil)) Modified: trunk/projects/lisp-ecoop/src/participant.lisp =================================================================== --- trunk/projects/lisp-ecoop/src/participant.lisp 2009-02-20 13:28:45 UTC (rev 4306) +++ trunk/projects/lisp-ecoop/src/participant.lisp 2009-02-23 11:25:25 UTC (rev 4307) @@ -128,7 +128,7 @@ :text (format nil "Your participant account on the LISP ECOOP Workshop website has been created. Please visit your personal profile page on -http://elw2008.bknr.net/edit-profile/ to change your password +http://elw2009.bknr.net/edit-profile/ to change your password and update your profile information. Your login name is: ~A @@ -148,7 +148,7 @@ :text (format nil "Your password on the LISP ECOOP Workshop website has been reset. Please visit your personal profile page on -http://elw2008.bknr.net/edit-profile/~A to change your password +http://elw2009.bknr.net/edit-profile/~A to change your password and update your profile information. Your login name is: ~A Modified: trunk/projects/lisp-ecoop/src/webserver.lisp =================================================================== --- trunk/projects/lisp-ecoop/src/webserver.lisp 2009-02-20 13:28:45 UTC (rev 4306) +++ trunk/projects/lisp-ecoop/src/webserver.lisp 2009-02-23 11:25:25 UTC (rev 4307) @@ -5,10 +5,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#+(or) -(defun make-daily-statistics () - (bknr.stats::make-yesterdays-stats :delete-events t :remove-referer-hosts '("lisp-ecoop.bknr.net"))) - (defun publish-lisp-ecoop (&key (base-href *base-path*)) (unless (bknr.cron:cron-job-with-name "daily webserver statistics") @@ -24,7 +20,6 @@ ("http://bknr.net/menu" . :bknr.site-menu)) :handler-definitions `(user images - stats ("/handler-statistics" bknr.web::handler-statistics-handler) mailinglist mailinglist-registration @@ -38,11 +33,20 @@ :style-sheet-urls (list (format nil "~Astatic/styles.css" base-href)) :javascript-urls (list (format nil "~Astatic/javascript.js" base-href)))) -(defun start-webserver (&key (host "elw2008.bknr.net") (port 80) (backend-port 9001)) +(defvar *server*) + +(defun start-webserver (&key (host "elw2009.bknr.net") + (port 80) + (backend-port 9001) + (start-frontend t)) (when (and (boundp '*server*) *server*) - (stop-server *server*)) + (stop *server*)) (publish-lisp-ecoop) (setf *hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) hunchentoot:*rewrite-for-session-urls* nil) - (setq *server* (start-server :port backend-port)) - (start-frontend :host host :backend-port backend-port :port port)) + (setq *server* (make-instance 'hunchentoot:acceptor + :port backend-port + :request-dispatcher 'bknr.web:bknr-dispatch)) + (start *server*) + (when start-frontend + (start-frontend :host host :backend-port backend-port :port port))) From bknr at bknr.net Mon Feb 23 11:26:45 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 12:26:45 +0100 Subject: [bknr-cvs] hans changed trunk/bknr/web/src/ Message-ID: Revision: 4308 Author: hans URL: http://bknr.net/trac/changeset/4308 Hunchentoot 1.0.0 changes (not complete) U trunk/bknr/web/src/packages.lisp U trunk/bknr/web/src/web/handlers.lisp U trunk/bknr/web/src/web/web-macros.lisp Modified: trunk/bknr/web/src/packages.lisp =================================================================== --- trunk/bknr/web/src/packages.lisp 2009-02-23 11:25:25 UTC (rev 4307) +++ trunk/bknr/web/src/packages.lisp 2009-02-23 11:26:45 UTC (rev 4308) @@ -256,6 +256,7 @@ #:*template-dtd-catalog* ;; handlers + #:bknr-dispatch #:parse-handler-url #:*website* #:website Modified: trunk/bknr/web/src/web/handlers.lisp =================================================================== --- trunk/bknr/web/src/web/handlers.lisp 2009-02-23 11:25:25 UTC (rev 4307) +++ trunk/bknr/web/src/web/handlers.lisp 2009-02-23 11:26:45 UTC (rev 4308) @@ -358,13 +358,13 @@ (handler (cond ((authorized-p handler) - (curry #'invoke-handler handler)) + (invoke-handler handler)) (t (setf (session-value :login-redirect-uri) (redirect-uri (parse-uri (script-name*)))) (redirect "/login")))) (t - 'error-404)))) + (error-404))))) (defmethod publish-handler ((website website) (handler page-handler)) (setf *handlers* (append *handlers* (list handler)))) @@ -487,7 +487,7 @@ (filenames (if (directory-handler-filename-separator handler) (mapcar #'pathname (split (directory-handler-filename-separator handler) pathnames-argument)) - pathnames-argument)) + (list pathnames-argument))) (types (mapcar #'pathname-type filenames))) (unless (every #'equal types (cdr types)) (error 'non-matching-filetypes-in-combination :pathnames-argument pathnames-argument)) @@ -694,7 +694,7 @@ (defmethod handle-object ((handler blob-handler) (blob blob)) (with-http-response (:content-type (blob-mime-type blob)) - (setf (content-length) (blob-size blob)) + (setf (content-length*) (blob-size blob)) (let ((stream (send-headers))) (blob-to-stream blob stream)))) @@ -746,7 +746,7 @@ (:princ-safe error))))))) (defun show-page-with-error-handlers (fn &key (response +http-ok+) title) - (setf (return-code) response) + (setf (return-code*) response) (with-http-response (:content-type "text/html; charset=UTF-8" :response response) (with-http-body () (website-show-page *website* fn title)))) Modified: trunk/bknr/web/src/web/web-macros.lisp =================================================================== --- trunk/bknr/web/src/web/web-macros.lisp 2009-02-23 11:25:25 UTC (rev 4307) +++ trunk/bknr/web/src/web/web-macros.lisp 2009-02-23 11:26:45 UTC (rev 4308) @@ -56,8 +56,8 @@ (defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &body body) `(progn - (setf (content-type) ,content-type) - (setf (return-code) ,response) + (setf (content-type*) ,content-type) + (setf (return-code*) ,response) , at body)) (defmacro with-http-body ((&key external-format) &body body) From bknr at bknr.net Mon Feb 23 13:27:55 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 14:27:55 +0100 Subject: [bknr-cvs] hans changed trunk/bknr/datastore/src/data/package.lisp Message-ID: Revision: 4310 Author: hans URL: http://bknr.net/trac/changeset/4310 Remove unused exported symbols. U trunk/bknr/datastore/src/data/package.lisp Modified: trunk/bknr/datastore/src/data/package.lisp =================================================================== --- trunk/bknr/datastore/src/data/package.lisp 2009-02-23 13:05:18 UTC (rev 4309) +++ trunk/bknr/datastore/src/data/package.lisp 2009-02-23 13:27:54 UTC (rev 4310) @@ -22,10 +22,6 @@ #:sleep |# - ;; session - #:session - #:session-status - ;; store #:store #:mp-store From bknr at bknr.net Mon Feb 23 13:05:18 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 14:05:18 +0100 Subject: [bknr-cvs] dverna changed trunk/projects/lisp-ecoop/website/templates/ Message-ID: Revision: 4309 Author: dverna URL: http://bknr.net/trac/changeset/4309 First shot at 2009 U trunk/projects/lisp-ecoop/website/templates/cfp.xml U trunk/projects/lisp-ecoop/website/templates/contact.xml U trunk/projects/lisp-ecoop/website/templates/home.xml U trunk/projects/lisp-ecoop/website/templates/news.xml U trunk/projects/lisp-ecoop/website/templates/programme.xml U trunk/projects/lisp-ecoop/website/templates/submissions.xml Modified: trunk/projects/lisp-ecoop/website/templates/cfp.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -4,34 +4,31 @@ 
          +------------------------------------------------------------+
      |                       CALL FOR PAPERS                      |
-     |                 5th European Lisp Workshop                 |
-     |     July 7, Paphos, Cyprus - co-located with ECOOP 2008    |
+     |                 6th European Lisp Workshop                 |
+     |     July 6, Genova, Italy - co-located with ECOOP 2009     |
      +------------------------------------------------------------+
 
 
-Important Dates:
-****************
-Submission deadline (papers and breakout groups): May  18, 2008
-Notification of acceptance:                       May  26, 2008
-ECOOP early registration deadline:                June 01, 2008
-5th European Lisp Workshop:                       July 07, 2008
+Important Dates
+===============
+Submission deadline:               April 08, 2009
+Notification of acceptance:        May   08, 2009
+ECOOP early registration deadline: May   20, 2009
+5th European Lisp Workshop:        July  06, 2009
 
-For more information visit http://elw.bknr.net/2008/
+Please note that registration must be done with ECOOP itself.
+For more information visit http://elw.bknr.net/2009/
 Contact: Didier Verna, didier at lrde.epita.fr
 
 
-Organizers
-**********
+2009 Special News
+=================
+This year, and for the first time, the workshop proceedings will be
+published in the ACM Digital Library.
 
-Didier Verna, EPITA Research and Development Laboratory, Paris
-Christophe Rhodes, Goldsmiths College, University of London
-Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel
-Hans H??bner, Software Developer, Berlin
 
-
 Overview
-********
-
+========
 "...Please don't assume Lisp is only useful for Animation and
 Graphics, AI, Bioinformatics, B2B and E-Commerce, Data Mining,
 EDA/Semiconductor applications, Expert Systems, Finance, Intelligent
@@ -41,90 +38,63 @@
 happened to list."
   -- Kent Pitman
 
-Lisp is one of the oldest computer languages still in use today. In
-the decades of its existence, Lisp has been a fruitful basis for
-language design experiments as well as the preferred implementation
-language for applications in diverse fields.
+Lisp, one of the eldest computer languages still in use today, is
+gaining momentum again. The structure of Lisp makes it easy to extend
+the language or even to implement entirely new dialects without
+starting from scratch, making it the ideal candidate for writing
+Domain Specific Languages. Common Lisp, with the Common Lisp Object
+System (CLOS), was the first object-oriented programming language to
+receive an ANSI standard and retains the most complete and advanced
+object system of any programming language, while influencing many
+other object-oriented programming languages that followed.
 
-The structure of Lisp makes it easy to extend the language or even to
-implement entirely new dialects without starting from scratch. Common
-Lisp, with the Common Lisp Object System (CLOS), was the first
-object-oriented programming language to receive an ANSI standard and
-retains the most complete and advanced object system of any
-programming language, while influencing many other object-oriented
-programming languages that followed.
-
-It is clear that Lisp is gaining momentum: there is a steadily growing
-interest in Lisp itself, with numerous user groups in existence
-worldwide, and in Lisp's metaprogramming notions which are being
-transferred to other languages, as for example in Aspect-Oriented
-Programming, support for Domain-Specific Languages, and so on.
-
 This workshop will address the near-future role of Lisp-based
-languages in research, industry and education. We solicit papers and
-suggestions for breakout groups that discuss the opportunities Lisp
-provides to capture and enhance the possibilities in software
-engineering. We want to promote lively discussion between researchers
-proposing new approaches and practitioners reporting on their
-experience with the strengths and limitations of current Lisp
-technologies.
+languages in research, industry and education. We solicit
+contributions that discuss the opportunities Lisp provides to capture
+and enhance the possibilities in software engineering. We want to
+promote lively discussion between researchers proposing new approaches
+and practitioners reporting on their experience with the strengths and
+limitations of current Lisp technologies.
 
-The workshop will have two components: there will be
-formally-presented talks, and breakout groups discussing or working on
-particular topics. Additionally, there will be opportunities for
-short, informal talks and demonstrations on experience reports,
-underappreciated results, software under development, or other topics
-of interest.
+The workshop will have two components: there will be formal talks, and
+interactive turorial/demo/coding sessions.
 
 
 Papers
-******
-
+======
 Formal presentations in the workshop should take between 20 minutes
 and half an hour; additional time will be given for questions and
-answers. We encourage that papers be published on the website, to
-provide all participants with background information in advance.
+answers. Suggested topics include (but are not limited to):
 
-Suggested Topics:
-- New language features or abstractions
-- Experience reports or case studies
-- Protocol Metaprogramming and Libraries
+- Experience reports / Case studies
 - Educational approaches
 - Software Evolution
 - Development Aids
 - Persistent Systems
 - Dynamic Optimization
 - Implementation techniques
-- Innovative Applications
-- Hardware Support for Lisp systems
+- Hardware Support
+- Efficiency / Distribution / Parallel programming
 - Macro-, reflective-, meta- and/or rule-based development approaches
-- Aspect-Oriented, Domain-Oriented and Generative Programming
+- Protocol Metaprogramming and Libraries
+- Context-Oriented, Domain-Oriented and Generative Programming
 
 
-Breakout Groups
-***************
+Interactive Tutorial/Demo/Coding Sessions
+=========================================
+Additionally, we invite less formal talks in the form of interactive
+tutorial/demo/coding sessions. The purpose of these sessions is to
+both demonstrate and recieve feedback on any interesting Lisp system,
+either stable or under development. Being less formal than technical
+paper presentations, it is expected that these sessions be highly
+interactive.
 
-The workshop will provide for the opportunity to meet face to face and
-work on focused topics. We will organize these breakout groups and
-provide for rooms and infrastructure.
 
-Suggested Topics for Breakout Groups:
-- Lisp Infrastructure Development and Distribution
-- Language Features (e.g. Predicate Dispatching)
-- Environments for creating web applications
-- Brainstorming sessions for new or existing open source projects
-- Persistence Systems
-- Compiler technology
-- Lisp on bare metal / Lisp hardware / Lisp operating systems
-- Compare and enhance curricula for computer science education
-
-
 Submission Guidelines
-*********************
+=====================
+Potential contributors are encouraged to submit:
 
-Potential attendees are encouraged to submit:
-
-- a long paper (10 pages) presenting scientific and/or
+- a long paper (around 10 pages) presenting scientific and/or
   empirical results about Lisp-based uses or new approaches for
   software engineering purposes,
 
@@ -132,10 +102,20 @@
   research, practice or education based on Lisp should be heading in
   the near future,
 
-- a proposal for a breakout group (1-2 pages) describing the theme, an
-  agenda and/or expected results.
+- a proposal for an interactive tutorial/demo/coding session (1-2
+  pages) describing the involved library or application, and the
+  subject of the session.
 
 Submissions should be mailed as PDF to Didier Verna
 (didier at lrde.epita.fr) before the submission deadline.
+
+
+Organizers
+==========
+
+Didier Verna, EPITA Research and Development Laboratory, Paris
+Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel
+Christophe Rhodes, Goldsmiths College, University of London
+Hans H??bner, Software Developer, Berlin
    Modified: trunk/projects/lisp-ecoop/website/templates/contact.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -27,13 +27,10 @@ , Goldsmiths College, University of London, United Kingdom
    • -
  • Hans H??bner, Software Developer, Berlin, Germany
    • - - -

    Contact

    +

    Contact

    Workshop related: Didier Verna Modified: trunk/projects/lisp-ecoop/website/templates/home.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/home.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/home.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -5,8 +5,9 @@

    5th European Lisp Workshop

    -

    July 07 - Paphos, Cyprus - co-located with ECOOP 2008

    +

    July 06 - Genova, Italy - co-located with ECOOP 2009

    +

    Important News

      +
    • + This year, and for the first time, the workshop proceedings will be + published in the ACM Digital Library. +
      • +

    Important Dates

      -
    • Submission deadline: - EXTENDED May 18, 2008 -
      • -
    • Notification of acceptance: May 26, 2008
      • -
    • ECOOP early registration deadline: June 01, 2008
      • +
    • Submission deadline: April 08, 2009
      • +
    • Notification of acceptance: May 08, 2009
      • +
    • ECOOP early registration deadline: May 20, 2009

    Overview

    @@ -83,45 +89,30 @@

    -Lisp is one of the oldest computer languages still in use today. In the -decades of its existence, Lisp has been a fruitful basis for language design -experiments as well as the preferred implementation language for applications -in diverse fields. -

    - -

    -The structure of Lisp makes it easy to extend the language or even to -implement entirely new dialects without starting from scratch. Common Lisp, -with the Common Lisp Object System (CLOS), was the first object-oriented -programming language to receive an ANSI standard and retains the most complete -and advanced object system of any programming language, while influencing many +Lisp, one of the eldest computer languages still in use today, is +gaining momentum again. The structure of Lisp makes it easy to extend +the language or even to implement entirely new dialects without +starting from scratch, making it the ideal candidate for writing +Domain Specific Languages. Common Lisp, with the Common Lisp Object +System (CLOS), was the first object-oriented programming language to +receive an ANSI standard and retains the most complete and advanced +object system of any programming language, while influencing many other object-oriented programming languages that followed.

    -It is clear that Lisp is gaining momentum: there is a steadily growing -interest in Lisp itself, with numerous user groups in existence worldwide, and -in Lisp's metaprogramming notions which are being transferred to other -languages, as for example in Aspect-Oriented Programming, support for -Domain-Specific Languages, and so on. +This workshop will address the near-future role of Lisp-based +languages in research, industry and education. We solicit +contributions that discuss the opportunities Lisp provides to capture +and enhance the possibilities in software engineering. We want to +promote lively discussion between researchers proposing new approaches +and practitioners reporting on their experience with the strengths and +limitations of current Lisp technologies.

    -This workshop will address the near-future role of Lisp-based languages in -research, industry and education. We solicit papers and suggestions for -breakout groups that discuss the opportunities Lisp provides to capture and -enhance the possibilities in software engineering. We want to promote lively -discussion between researchers proposing new approaches and practitioners -reporting on their experience with the strengths and limitations of current -Lisp technologies. +The workshop will have two components: there will be formal talks, and +interactive turorial/demo/coding sessions.

    -

    -The workshop will have two components; there will be formally-presented talks, -and breakout groups discussing or working on particular topics. Additionally, -there will be opportunities for short, informal talks and demonstrations on -experience reports, underappreciated results, software under development, or -other topics of interest. -

    - Modified: trunk/projects/lisp-ecoop/website/templates/news.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/news.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/news.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -5,12 +5,13 @@

    News

    + + -

    May 05, 2008

    +

    February 23, 2009

      -
    • Deadline extension: May 18 (notification: May 26).
      • +
    • + This year, and for the first time, the workshop proceedings will be + published in the ACM Digital Library. +
      • +
    • Launched the workshop website.
    -

    February 06, 2008

    -
      -
    • Launched the workshop website.
      • -
    - Modified: trunk/projects/lisp-ecoop/website/templates/programme.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/programme.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/programme.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -5,33 +5,6 @@

    Workshop Programme

    -

    9:15 - 11:30

    -
      -
    • Opening
      • -
    • Keynote 1 -- Mark Tarver, "Lisp for the 21st Century"
      • -
    • Paper 1 -- Michael Wessel, "Software Abstractions for Description Logic Systems"
      • -
    +The programme will be avaible by the end of May 2009. -

    11:30 - 12:00

    -
      -
    • Coffee break
      • -
    - -

    12:00 - 13:30

    -
      -
    • Paper 2 -- Leonardo Uribe, "Using Data Parallelism in Lisp for Implementing a Quantum Simulator"
      • -
    • Paper 3 -- Geoff Wozniak, "Adaptive Libraries and Interactive Code Generation for Common Lisp"
      • -
    - -

    13:30 - 15:00

    -
      -
    • Lunch break
      • -
    - -

    15:00 - 17:00

    -
      -
    • Keynote 2 -- Rich Hickey, "A detailed Look at the Lisp Nature of Clojure"
      • -
    • Paper 4 -- Pascal Costanza, "make-method-lambda Considered Harmful"
      • -
    - Modified: trunk/projects/lisp-ecoop/website/templates/submissions.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/submissions.xml 2009-02-23 11:26:45 UTC (rev 4308) +++ trunk/projects/lisp-ecoop/website/templates/submissions.xml 2009-02-23 13:05:18 UTC (rev 4309) @@ -5,15 +5,16 @@

    Submissions

    +

    Papers

    -

    We have accepted the following submissions.

    - - + +The list of accepted submissions will be available in June. + - +

    Interactive Turorial/Demo/Coding Sessions

    + From bknr at bknr.net Mon Feb 23 13:56:35 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 14:56:35 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/cl-gd Message-ID: Revision: 4311 Author: hans URL: http://bknr.net/trac/changeset/4311 rename cl-gd-0.5.6 to not have version number in its path. A trunk/thirdparty/cl-gd/ D trunk/thirdparty/cl-gd-0.5.6/ Copied: trunk/thirdparty/cl-gd (from rev 4310, trunk/thirdparty/cl-gd-0.5.6) From bknr at bknr.net Mon Feb 23 14:37:04 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 15:37:04 +0100 Subject: [bknr-cvs] dverna changed trunk/projects/lisp-ecoop/website/templates/cfp.xml Message-ID: Revision: 4312 Author: dverna URL: http://bknr.net/trac/changeset/4312 cfp update 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-02-23 13:56:35 UTC (rev 4311) +++ trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-02-23 14:37:04 UTC (rev 4312) @@ -24,7 +24,8 @@ 2009 Special News ================= This year, and for the first time, the workshop proceedings will be -published in the ACM Digital Library. +published in the ACM Digital Library. Also, the workshop will feature +interactive tutorial/demo/coding sessions (see below). Overview From bknr at bknr.net Mon Feb 23 16:47:25 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 17:47:25 +0100 Subject: [bknr-cvs] dverna changed trunk/projects/lisp-ecoop/website/templates/c Message-ID: Revision: 4313 Author: dverna URL: http://bknr.net/trac/changeset/4313 Add Robert Strandh to the team U trunk/projects/lisp-ecoop/website/templates/cfp.xml U trunk/projects/lisp-ecoop/website/templates/contact.xml Modified: trunk/projects/lisp-ecoop/website/templates/cfp.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-02-23 14:37:04 UTC (rev 4312) +++ trunk/projects/lisp-ecoop/website/templates/cfp.xml 2009-02-23 16:47:25 UTC (rev 4313) @@ -116,6 +116,7 @@ Didier Verna, EPITA Research and Development Laboratory, Paris Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel +Robert Strandh, LaBRI, University of Bordeaux I, France Christophe Rhodes, Goldsmiths College, University of London Hans H??bner, Software Developer, Berlin Modified: trunk/projects/lisp-ecoop/website/templates/contact.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 14:37:04 UTC (rev 4312) +++ trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 16:47:25 UTC (rev 4313) @@ -8,25 +8,22 @@

    The organizing comitee consists of the following people:

      -
    • -Didier Verna, - -http://www.lrde.epita.fr/~didier -, -EPITA Research and Development Laboratory, Paris, France (contact organizer) + Didier Verna, + EPITA Research and Development Laboratory, Paris, France (contact organizer)
    • -Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel, -Belgium + Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel, + Belgium
    • -Christophe Rhodes, - -http://www.doc.gold.ac.uk/~mas01cr/ -, -Goldsmiths College, University of London, United Kingdom + Robert Strandh, + LaBRI, University of Bordeaux I, France
      • +
    • + Christophe Rhodes, + Goldsmiths College, University of London, United Kingdom +
    • Hans H??bner, Software Developer, Berlin, Germany
    From bknr at bknr.net Mon Feb 23 16:49:20 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 17:49:20 +0100 Subject: [bknr-cvs] dverna changed trunk/projects/lisp-ecoop/website/templates/contact.xml Message-ID: Revision: 4314 Author: dverna URL: http://bknr.net/trac/changeset/4314 Link to Charlotte's website U trunk/projects/lisp-ecoop/website/templates/contact.xml Modified: trunk/projects/lisp-ecoop/website/templates/contact.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 16:47:25 UTC (rev 4313) +++ trunk/projects/lisp-ecoop/website/templates/contact.xml 2009-02-23 16:49:20 UTC (rev 4314) @@ -13,7 +13,8 @@ EPITA Research and Development Laboratory, Paris, France (contact organizer)
  • - Charlotte Herzeel, Programming Technology Lab, Vrije Universiteit, Brussel, + Charlotte Herzeel, + Programming Technology Lab, Vrije Universiteit, Brussel, Belgium
  • From bknr at bknr.net Mon Feb 23 16:53:08 2009 From: bknr at bknr.net (BKNR Commits) Date: Mon, 23 Feb 2009 17:53:08 +0100 Subject: [bknr-cvs] dverna changed trunk/projects/lisp-ecoop/website/templates/ Message-ID: Revision: 4315 Author: dverna URL: http://bknr.net/trac/changeset/4315 Misc fixes in homepage and headers U trunk/projects/lisp-ecoop/website/templates/home.xml U trunk/projects/lisp-ecoop/website/templates/lisp-ecoop.xsl Modified: trunk/projects/lisp-ecoop/website/templates/home.xml =================================================================== --- trunk/projects/lisp-ecoop/website/templates/home.xml 2009-02-23 16:49:20 UTC (rev 4314) +++ trunk/projects/lisp-ecoop/website/templates/home.xml 2009-02-23 16:53:08 UTC (rev 4315) @@ -3,7 +3,7 @@ -

    5th European Lisp Workshop

    +

    6th European Lisp Workshop

    July 06 - Genova, Italy - co-located with ECOOP 2009

    @@ -37,6 +37,9 @@ This year, and for the first time, the workshop proceedings will be published in the ACM Digital Library.
    • +
  • + Also, the workshop will feature interactive tutorial/demo/coding sessions. +