- removed all direct references to package 'bt' (used wrappers instead);

- addedd missing file 'dummy-server.lisp';

- updated LICENSES.org.

LICENSES.org

@@ -1,6 +1,43 @@
+- src/gemini/dummy-server.lisp
+
+  derived from:
+
+  Copyright © 2001, 2003  Eric Marsden
+  Copyright © ????  Jochen Schmidt
+  Copyright © 2005  David Lichteblau
+  Copyright © 2007  Pixel // pinterface
+  Copyright © contributors as per cl+ssl git history
+
+  - License first changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
+    from plain LGPL to Lisp-LGPL in December 2005.
+
+  - License then changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
+    from Lisp-LGPL to MIT-style in January 2007.
+
+
+    Permission is hereby granted, free of charge, to any person
+    obtaining a copy of this software and associated documentation files
+    (the "Software"), to deal in the Software without restriction,
+    including without limitation the rights to use, copy, modify, merge,
+    publish, distribute, sublicense, and/or sell copies of the Software,
+    and to permit persons to whom the Software is furnished to do so,
+    subject to the following conditions:
+
+    The above copyright notice and this permission notice shall be
+    included in all copies or substantial portions of the Software.
+
+    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+    EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+    NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+    BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+    ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+    CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+    SOFTWARE.
+
 - src/hooks
   derived from
-  Copyright (c) 2014 Paul M. Rodriguez
+  Copyright © 2014 Paul M. Rodriguez
 
   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the
@@ -29,7 +66,7 @@
 
   uses code from:
   niccolo': a chemicals inventory
-  Copyright (C) 2016  Universita' degli Studi di Palermo
+  Copyright © 2016  Universita' degli Studi di Palermo
 
   This  program is  free  software: you  can  redistribute it  and/or
   modify it  under the  terms of  the GNU  General Public  License as
@@ -71,7 +108,7 @@
 
   function display-corrupting-utf8-p is derived from mutt:
 
-  Copyright (C) 2000 Edmund Grimley Evans <edmundo@rano.org>
+  Copyright © 2000 Edmund Grimley Evans <edmundo@rano.org>
 
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
@@ -119,7 +156,7 @@
 - src/misc-utils.lisp
 
   'unsplice' derived from
-  Copyright (c) 2011-2012, James M. Lawrence. All rights reserved.
+  Copyright © 2011-2012, James M. Lawrence. All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
   modification, are permitted provided that the following conditions
@@ -152,7 +189,7 @@
   according to: https://github.com/lmj/lparallel
 
   'intersperse' family of functions derives from serapeum
-  Copyright (c) 2014 Paul M. Rodriguez
+  Copyright © 2014 Paul M. Rodriguez
 
   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the
@@ -177,7 +214,7 @@
 
   uses code from:
   niccolo': a chemicals inventory
-  Copyright (C) 2016  Universita' degli Studi di Palermo
+  Copyright © 2016  Universita' degli Studi di Palermo
 
   This  program is  free  software: you  can  redistribute it  and/or
   modify it  under the  terms of  the GNU  General Public  License as
@@ -213,7 +250,7 @@
   SOFTWARE.
 
   uses code derived from:
-  local-time Copyright (c) 2005-2012 by Daniel Lowe
+  local-time Copyright © 2005-2012 by Daniel Lowe
 
   Permission  is  hereby  granted,  free  of  charge,  to  any  person
   obtaining a copy of this software and associated documentation files
@@ -236,7 +273,7 @@
   SOFTWARE.
 
  uses code derived from:
-  local-time Copyright (c) 2005-2012 by Daniel Lowe
+  local-time Copyright © 2005-2012 by Daniel Lowe
 
   Permission  is  hereby  granted,  free  of  charge,  to  any  person
   obtaining a copy of this software and associated documentation files
@@ -260,7 +297,7 @@
 
  uses code derived from:
 
-  quicklisp    controller   Copyright    (c)   2013    Zachary   Beane
+  quicklisp    controller   Copyright    ©   2013    Zachary   Beane
   <xach@xach.com>, All Rights Reserved
 
   Redistribution and use in source and binary forms, with or without
@@ -289,7 +326,7 @@
 
 - src/complete.lisp
   derived from linedit
-  Copyright (c) 2003, 2004 Nikodemus Siivola, Julian Squires
+  Copyright © 2003, 2004 Nikodemus Siivola, Julian Squires
 
   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the
@@ -312,11 +349,11 @@
 
 - src/windows.lisp
   uses code from croatoan
-  Copyright (c) 2012-2019,2020 Anton Vidovic <anton.vidovic@gmx.de>
+  Copyright © 2012-2019,2020 Anton Vidovic <anton.vidovic@gmx.de>
 
-  Portions Copyright (c) 2018 Daniel Vedder <d.vedder@web.de>
+  Portions Copyright © 2018 Daniel Vedder <d.vedder@web.de>
-  Portions Copyright (c) 2019 D4ryus <d4ryus@teknik.io>
+  Portions Copyright © 2019 D4ryus <d4ryus@teknik.io>
-  Portions Copyright (c) 2019-2020 cage2 <github.com/cage2>
+  Portions Copyright © 2019-2020 cage2 <github.com/cage2>
 
   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
@@ -343,7 +380,7 @@
 
   MIT License
 
-  Copyright (c) 2017-2019 Miles Johnson
+  Copyright © 2017-2019 Miles Johnson
 
   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
@@ -367,10 +404,10 @@
 
   derived from cl+ssl
 
-  Copyright (C) 2001, 2003  Eric Marsden
+  Copyright © 2001, 2003  Eric Marsden
-  Copyright (C) ????  Jochen Schmidt
+  Copyright © ????  Jochen Schmidt
-  Copyright (C) 2005  David Lichteblau
+  Copyright © 2005  David Lichteblau
-  Copyright (C) 2007  Pixel // pinterface
+  Copyright © 2007  Pixel // pinterface
 
   - License first changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
     from plain LGPL to Lisp-LGPL in December 2005.
@@ -407,9 +444,9 @@
   (This is the MIT / X Consortium license as taken from
   http://www.opensource.org/licenses/mit-license.html)
 
-  Copyright (c) 2003 Erik Enge
+  Copyright © 2003 Erik Enge
-  Copyright (c) 2006-2007 Erik Huelsmann
+  Copyright © 2006-2007 Erik Huelsmann
-  Copyright (c) 2008-2019 Hans Hueber and Chun Tian
+  Copyright © 2008-2019 Hans Hueber and Chun Tian
 
   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the

src/api-client.lisp

@@ -23,7 +23,7 @@
   "An istance of 'credentials' used to holds the intormation needed to
   access a mastodon instance")
 
-(defparameter *client-lock* (bt:make-lock)
+(defparameter *client-lock* (make-lock)
   "The Lock for prevent race conditions when accessing the mastodon server")
 
 (define-constant +credentials-filename+ "client"    :test #'string=

src/gemini-viewer.lisp

@@ -17,7 +17,7 @@
 
 (in-package :gemini-viewer)
 
-(defparameter *gemini-db-streams-lock* (bt:make-lock))
+(defparameter *gemini-db-streams-lock* (make-lock))
 
 (define-constant +read-buffer-size+ 2048 :test #'=
   :documentation "Chunk's size of the buffer when reading non gemini contents from stream")
@@ -107,7 +107,7 @@
 
 (defclass gemini-stream ()
   ((download-thread-lock
-    :initform (bt:make-lock "download-gemini")
+    :initform (make-lock "download-gemini")
     :initarg  :download-thread-lock
     :accessor download-thread-lock)
    (download-thread-blocked
@@ -261,7 +261,7 @@
                    (thread        thread)
                    (stream-status stream-status)
                    (download-iri  download-iri)) object
-    (setf thread (bt:make-thread function))
+    (setf thread (make-thread function))
     (setf start-time (db-utils:local-time-obj-now))
     (setf download-iri (gemini-parser:make-gemini-iri host
                                                       path

src/gemini/dummy-server.lisp

@@ -0,0 +1,68 @@
+;; tinmop: a multiprotocol client
+;; Copyright © cage
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.
+;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
+
+(in-package :gemini-dummy-server)
+
+(cffi:defcallback no-verify :int ((preverify-ok :int) (x509-store-ctx :pointer))
+  (declare (ignore preverify-ok x509-store-ctx))
+  1)
+
+(defun start (&optional (port +gemini-default-port+))
+  "Start a  trivial server listening  on `PORT' using  the certificate
+and  key   stored  in  the   file  pointed  by  the   filesystem  path
+`CERTIFICATE' and `KEY' respectively"
+  (multiple-value-bind (certificate key)
+      (os-utils:generate-ssl-certificate (os-utils:default-temp-dir))
+    (format t
+            "generated certificate and private key in ~s ~s respectively~%"
+            certificate
+            key)
+    (let ((server (usocket:socket-listen "127.0.0.1" port :element-type '(unsigned-byte 8))))
+      (format t "SSL server listening on port ~d~%" port)
+      (unwind-protect
+           (labels ((get-data ()
+                      (let* ((client-socket (usocket:socket-accept server))
+                             (client-stream (usocket:socket-stream client-socket)))
+                        (format t "opening socket~%")
+                        (let ((ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-peer+
+                                                        :verify-callback 'no-verify)))
+                          (cl+ssl:with-global-context (ctx :auto-free-p t)
+                            (let* ((stream (cl+ssl:make-ssl-server-stream client-stream
+                                                                          :external-format
+                                                                          nil
+                                                                          :certificate
+                                                                          certificate
+                                                                          :key
+                                                                          key))
+                                   (client-cert-fingerprint (x509:certificate-fingerprint stream)))
+                              (let* ((data    (misc:read-line-into-array stream))
+                                     (request (text-utils:trim-blanks (text-utils:to-s data))))
+                                (format t
+                                        "request ~s fingerprint ~a~%"
+                                        request
+                                        client-cert-fingerprint)
+                                (when (null client-cert-fingerprint)
+                                  (let ((response (format nil
+                                                          "~a please provide a certificate~a~a"
+                                                          (code gemini-client::+60+)
+                                                          #\return #\newline)))
+                                  (write-sequence (text-utils:string->octets response)
+                                                  stream)
+                                    (close stream)
+                                    (get-data))))))))))
+             (get-data))
+        (usocket:socket-close server)))))

src/gemini/gemini-parser.lisp

@@ -21,7 +21,7 @@
 
 (defparameter *list-detected* nil)
 
-(defparameter *parser-lock* (bt:make-lock))
+(defparameter *parser-lock* (make-lock))
 
 (defparameter *pre-group-id* -1)
 

src/gui/client/json-rpc-communication.lisp

@@ -45,7 +45,7 @@
   (write-byte (logand object #xff) *server-stream*)
   (finish-output *server-stream*))
 
-(defparameter *request-lock* (bt:make-lock))
+(defparameter *request-lock* (make-lock))
 
 (defgeneric make-request (method id &rest args))
 

src/gui/client/main-window.lisp

@@ -12,7 +12,7 @@
     :initarg :status
     :accessor status)
    (status-lock
-    :initform (bt:make-lock)
+    :initform (make-lock)
     :reader status-lock)
    (fetching-thread
     :initform nil
@@ -37,7 +37,7 @@
 
 (defparameter *gemini-streams-db* ())
 
-(defparameter *gemini-streams-db-lock* (bt:make-lock "gemini-streams-db-lock"))
+(defparameter *gemini-streams-db-lock* (make-lock "gemini-streams-db-lock"))
 
 (defun push-db-stream (stream-object)
   (misc:with-lock (*gemini-streams-db-lock*)
@@ -80,9 +80,9 @@
 (defmethod stop-stream-thread ((object gemini-stream))
   (with-accessors ((fetching-thread fetching-thread)) object
     (abort-downloading object)
-    (when (and (bt:threadp fetching-thread)
+    (when (and (threadp fetching-thread)
-               (bt:thread-alive-p fetching-thread))
+               (thread-alive-p fetching-thread))
-      (bt:join-thread fetching-thread)))
+      (join-thread fetching-thread)))
   object)
 
 (defmethod stop-stream-thread ((object string))
@@ -204,7 +204,7 @@
       (flet ((aborting-function ()
                (eq (status stream-wrapper) +stream-status-canceled+)))
         (print-info-message (_ "Stream started"))
-        (let ((stream-thread (bt:make-thread (lambda ()
+        (let ((stream-thread (make-thread (lambda ()
                                                (slurp-gemini-stream main-window
                                                                     iri
                                                                     stream-wrapper
@@ -1427,7 +1427,7 @@ local file paths."
     :initarg  :ir-lines
     :accessor ir-lines)
    (interrupt-rendering-lock
-    :initform (bt:make-lock "render-lock")
+    :initform (make-lock "render-lock")
     :initarg  :interrupt-rendering-lock
     :accessor interrupt-rendering-lock)
    (interrupt-rendering

src/gui/client/program-events.lisp

@@ -2,7 +2,7 @@
 
 (defparameter *stop-events-loop* t)
 
-(defparameter *events-loop-lock* (bt:make-lock "events-loop-lock"))
+(defparameter *events-loop-lock* (make-lock "events-loop-lock"))
 
 (defparameter *events-loop-thread* nil)
 
@@ -22,7 +22,7 @@
   (misc:with-lock (*events-loop-lock*)
     (setf *stop-events-loop* nil))
   (setf *events-loop-thread*
-        (bt:make-thread (lambda ()
+        (make-thread (lambda ()
                           (let ((gui:*wish* gui-goodies:*gui-server*))
                             (loop while (events-loop-running-p) do
                               (ev:dispatch-program-events-or-wait)))))))

src/misc-utils.lisp

@@ -996,7 +996,7 @@ to the array"
 
 ;; threads
 
-(defmacro with-lock ((lock) &body body)
+(defmacro with-lock-held ((lock) &body body)
   `(bt:with-lock-held (,lock)
      ,@body))
 
@@ -1006,7 +1006,7 @@ to the array"
     `(defun ,name ,parameters
        ,doc-string
        ,declarations
-       (with-lock (,lock)
+       (with-lock-held (,lock)
          ,@remaining-forms))))
 
 (defparameter *thread-default-special-bindings* bt:*default-special-bindings*)
@@ -1017,10 +1017,6 @@ to the array"
 (definline make-lock (&optional name)
   (bt:make-lock name))
 
-(defmacro with-lock-held ((lock) &body body)
-  `(bt:with-lock-held (,lock)
-     ,@body))
-
 (definline make-condition-variable (&key (name nil))
   (bt:make-condition-variable :name name))
 
@@ -1036,6 +1032,11 @@ to the array"
 (definline destroy-thread (thread)
   (bt:destroy-thread thread))
 
+(definline threadp (maybe-thread)
+  (bt:threadp maybe-thread))
+
+(definline thread-alive-p (thread)
+  (bt:thread-alive-p thread))
 
 ;; http
 

src/package.lisp

@@ -270,6 +270,8 @@
    :condition-notify
    :join-thread
    :destroy-thread
+   :threadp
+   :thread-alive-p
    :get-url-content
    :with-profile-time
    :with-debug-print-profile-time

src/program-events.lisp

@@ -23,7 +23,7 @@
 
 (define-constant +maximum-event-priority+   -2 :test #'=)
 
-(defparameter *id-lock* (bt:make-lock))
+(defparameter *id-lock* (make-lock))
 
 (defparameter *event-id* 0)
 
@@ -100,15 +100,15 @@
 
 (defclass events-queue (priority-queue)
   ((lock
-    :initform (bt:make-lock)
+    :initform (make-lock)
     :initarg  :lock
     :accessor lock)
    (blocking-lock
-    :initform (bt:make-lock)
+    :initform (make-lock)
     :initarg  :blocking-lock
     :accessor blocking-lock)
    (condition-variable
-    :initform (bt:make-condition-variable)
+    :initform (make-condition-variable)
     :initarg  :condition-variable
     :accessor condition-variable)))
 
@@ -155,14 +155,14 @@
   (with-lock ((blocking-lock *events-queue*))
     (loop while (emptyp *events-queue*)
           do
-             (bt:condition-wait (condition-variable *events-queue*)
+             (condition-wait (condition-variable *events-queue*)
                                 (blocking-lock *events-queue*)))
     (pop-element *events-queue*)))
 
 (defun push-event-unblock (value)
   (with-lock ((blocking-lock *events-queue*))
     (push-element *events-queue* value)
-    (bt:condition-notify (condition-variable *events-queue*))))
+    (condition-notify (condition-variable *events-queue*))))
 
 (defun push-event (event)
   (wrapped-in-lock (*events-queue*)
@@ -224,11 +224,11 @@
 
 (defclass event-on-own-thread (program-event)
   ((lock
-    :initform (bt:make-lock)
+    :initform (make-lock)
     :initarg  :lock
     :accessor lock)
    (condition-variable
-    :initform (bt:make-condition-variable)
+    :initform (make-condition-variable)
     :initarg  :condition-variable
     :accessor condition-variable))
   (:documentation  "This  is  the  parent  of  all  events  that  are
@@ -250,11 +250,11 @@
         (progn
           (setf (box:unbox results) (funcall callback))
           (with-lock (lock)
-            (bt:condition-notify condition-variable)))
+            (condition-notify condition-variable)))
       (error (e)
         (setf (box:unbox results) e)
         (with-lock (lock)
-          (bt:condition-notify condition-variable))))))
+          (condition-notify condition-variable))))))
 
 (defun push-function-and-wait-results (fn &key
                                             (priority +standard-event-priority+)
@@ -269,7 +269,7 @@
       (loop
         while (eq (box:unbox (results event)) :nothing)
         do
-           (bt:condition-wait condition-variable lock)))
+           (condition-wait condition-variable lock)))
     (let* ((event-results  (results event))
            (actual-results (box:unbox event-results)))
       (if (typep actual-results 'error)
@@ -345,7 +345,7 @@
     (setf (command-window:echo-character specials:*command-window*)
           :completed)
     (with-lock (lock)
-      (bt:condition-notify condition-variable))))
+      (condition-notify condition-variable))))
 
 (defclass notify-user-event (program-event)
   ((added-to-pending-p

src/tests/gemini-parser-tests.lisp

@@ -53,10 +53,10 @@ baz
                         collect
                         (progn
                           (sleep .01)
-                          (bt:make-thread function))))
+                          (make-thread function))))
          (results (loop for thread in threads
                         collect
-                        (bt:join-thread thread))))
+                        (join-thread thread))))
     (elt results (random (length results)))))
 
 (defun parse-stream ()

src/tests/program-events-tests.lisp

@@ -42,7 +42,7 @@
       (push-event event)
       (with-lock (lock)
         (format t "wait!~%")
-        (bt:condition-wait condition-variable lock)
+        (condition-wait condition-variable lock)
         (format t "input was ~a~%" (dunbox (payload event)))))))
 
 (defun main-thread ()
@@ -57,11 +57,11 @@
 (defun simulated-string-input ()
   (let ((payload                        (dbox "bar"))
         (program-events::*events-queue* (make-instance 'events-queue))
-        (main-thread                    (bt:make-thread #'main-thread)))
+        (main-thread                    (make-thread #'main-thread)))
     (sleep 3)
-    (bt:make-thread (lambda ()
+    (make-thread (lambda ()
                       (dummy-ask-string-input payload)))
-    (bt:join-thread main-thread)
+    (join-thread main-thread)
     payload))
 
 (defclass dummy-window () ())
@@ -81,7 +81,7 @@
   (flet ((callback () "callback called!"))
     (client-events:start-events-loop)
     (let ((res nil))
-      (bt:make-thread (lambda ()
+      (make-thread (lambda ()
                         (sleep 3)
                         (format t "push!~%")
                         (setf res

src/ui-goodies.lisp

@@ -135,7 +135,7 @@
                            (ending-message (_ "Task completed"))
                            (life-start     nil)
                            (life-end       nil))
-  (bt:make-thread (lambda ()
+  (make-thread (lambda ()
                     (when (string-not-empty-p starting-message)
                       (notify starting-message :life life-start))
                     (funcall procedure)
@@ -246,10 +246,10 @@
                    while (not (eq (command-window:echo-character *command-window*)
                                   :completed))
                    do
-                      (bt:condition-wait condition-variable lock))
+                      (condition-wait condition-variable lock))
                  (setf (command-window:echo-character *command-window*) nil)
                  (funcall on-input-complete-fn (box:dunbox (payload event))))))))
-      (bt:make-thread #'thread-fn)))
+      (make-thread #'thread-fn)))
 
 (defun thread-go-up ()
   (thread-window:go-message-up *thread-window*))