Planet Lisp

Alexander Artemenkocl-emb

· 12 hours ago

This is an interesting templating library. The most interesting features are:

  • named template pieces can call each other;
  • debug mode allows to inspect generated code;
  • different escape methods.

Here is how template functions can be reused:

POFTHEDAY> (cl-emb:register-emb "user-list"
            "
<ul>
  <% @loop users %>
    <li><% @call user %></li>
  <% @endloop %>
</ul>
")

POFTHEDAY> (cl-emb:register-emb "user"
            "<a href=\"/users/<% @var nickname %>\"><% @var name %></a>")

POFTHEDAY> (cl-emb:execute-emb "user-list"
             :env '(:users
                    ((:nickname "bob"
                      :name "Bob Hopkins")
                     (:nickname "alice"
                      :name "Alice Cooker"))))
"
<ul>
  
    <li><a href=\"/users/bob\">Bob Hopkins</a></li>
  
    <li><a href=\"/users/alice\">Alice Cooker</a></li>
  
</ul>
"

Let's see which code was generated for "user-list". To make this work, we'll need to set *debug* variable and recompile the template:

POFTHEDAY> (cl-emb:pprint-emb-function "user-list")

(LAMBDA
    (
     &KEY CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER
     CL-EMB-INTERN::NAME)
  (DECLARE (IGNORABLE CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER))
  (LET ((CL-EMB-INTERN::TOPENV CL-EMB-INTERN::ENV)
        (CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT
         (IF (TYPEP CL-EMB-INTERN::NAME 'PATHNAME)
             CL-EMB-INTERN::NAME
             *DEFAULT-PATHNAME-DEFAULTS*)))
    (DECLARE
     (IGNORABLE CL-EMB-INTERN::TOPENV CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT))
    (WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT*)
      (PROGN
       (WRITE-STRING "
<ul>
  ")
       (DOLIST
           (CL-EMB-INTERN::ENV
            (CL-EMB::AUTOFUNCALL (CL-EMB::GETF-EMB "users")))
         (WRITE-STRING "
    <li>")
         (FORMAT T "~A"
                 (LET ((CL-EMB:*ESCAPE-TYPE* CL-EMB:*ESCAPE-TYPE*))
                   (CL-EMB:EXECUTE-EMB "user" :ENV CL-EMB-INTERN::ENV
                                       :GENERATOR-MAKER
                                       CL-EMB-INTERN::GENERATOR-MAKER)))
         (WRITE-STRING "</li>
  "))
       (WRITE-STRING "
</ul>
")))))

As you can see, cl-emb generates a straight forward Lisp code.

Now let's check how fast cl-emb is and compare it to HTML template engines reviewed in previous days:

POFTHEDAY> (cl-emb:register-emb "render"
             "
<title><% @var title %></title>
<ul>
<% @loop items %><li><% @var value %></li><% @endloop %>
</ul>
")

POFTHEDAY> (time
            (loop repeat 1000000
                  do (cl-emb:execute-emb "render"
                       :env '(:title "Foo Bar"
                              :items ((:value "One")
                                      (:value "Two")
                                      (:value "Three"))))))
Evaluation took:
  1.436 seconds of real time
  1.441475 seconds of total run time (1.421158 user, 0.020317 system)
  [ Run times consist of 0.104 seconds GC time, and 1.338 seconds non-GC time. ]
  100.35% CPU
  3,172,183,256 processor cycles
  767,974,304 bytes consed

That is pretty fast. Slightly slower than Spinneret but faster than Zenekindarl.

To learn more about cl-emb's features, read it's docs!

Alexander Artemenkodjula

· 36 hours ago

This library is a port of Django templates. Its coolest feature are:

  • template inheritance;
  • autoreload;
  • internationalization.

Also, there is nice documentation. In presence of documentation, I won't provide many examples. Instead, let's implement a small function for our HTML templating engines performance test.

I didn't find the way to load a template from the string. That is why we need to set up the library and let it know where to search template files:

POFTHEDAY> djula:*current-store*
#<DJULA:FILE-STORE {100248A8C3}>

POFTHEDAY> (djula:find-template djula:*current-store*
                                "test.html")
; Debugger entered on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}>
[1] POFTHEDAY> 
; Evaluation aborted on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}>

POFTHEDAY> (djula:add-template-directory "templates/")
("templates/")

Now we need to write such template to the templates/test.html:

<h1>{{ title }}</h1>
<ul>
{% for item in items %}
  <li>{{ item }}</li>
{% endfor %}
</ul>

And we can test it:

POFTHEDAY> (djula:find-template djula:*current-store*
                                "test.html")
#P"/Users/art/projects/lisp/lisp-project-of-the-day/templates/test.html"


(defparameter +welcome.html+ (djula:compile-template* "welcome.html"))

POFTHEDAY> (with-output-to-string (s)
             (djula:render-template* (djula:compile-template* "test.html")
                                     s
                                     :title "Foo Bar"
                                     :items '("One" "Two" "Three")))
"<h1>Foo Bar</h1>
<ul>

  <li>One</li>

  <li>Two</li>

  <li>Three</li>

</ul>
"

It is time to measure performance:

;; We need this to turn off autoreloading
;; and get good performance:
POFTHEDAY> (pushnew :djula-prod *features*)

POFTHEDAY> (defparameter *template*
             (djula:compile-template* "test.html"))

POFTHEDAY> (defun render (title items)
             (with-output-to-string (s)
               (djula:render-template* *template*
                                       s
                                       :title title
                                       :items items)))

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render "Foo Bar"
                             '("One" "Two" "Three"))))
Evaluation took:
  4.479 seconds of real time
  4.487983 seconds of total run time (4.453540 user, 0.034443 system)
  [ Run times consist of 0.183 seconds GC time, and 4.305 seconds non-GC time. ]
  100.20% CPU
  9,891,631,814 processor cycles
  1,392,011,008 bytes consed

Pay attention to the line adding :djula-prod to the *features*. It disables auto-reloading. Withf enabled auto-reloading rendering is 2 times slower and takes 10.6 microseconds.

I could recommend Djula to everybody who works in a team where HTML designers are writing templates and don't want to dive into Lisp editing.

With Djula they will be able to easily fix templates and see results without changing the backend's code.

Also, today I've decided to create a base-line function which will create HTML using string concatenation as fast as possible. This way we'll be able to compare different HTML templating engines with the hand-written code:

POFTHEDAY> (defun render-concat (title items)
             "This function does not do proper HTML escaping."
             (flet ((to-string (value)
                      (format nil "~A" value)))
               (apply #'concatenate
                      'string
                      (append (list
                               "<title>"
                               (to-string title)
                               "</title>"
                               "<ul>")
                              (loop for item in items
                                    collect "<li>"
                                    collect (to-string item)
                                    collect "</li>")
                              (list
                               "</ul>")))))

POFTHEDAY> (render-concat "Foo Bar"
                          '("One" "Two" "Three"))
"<title>Foo Bar</title><ul><li>One</li><li>Two</li><li>Three</li></ul>"

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render-concat "Foo Bar"
                                    '("One" "Two" "Three"))))
Evaluation took:
  0.930 seconds of real time
  0.938568 seconds of total run time (0.919507 user, 0.019061 system)
  [ Run times consist of 0.114 seconds GC time, and 0.825 seconds non-GC time. ]
  100.97% CPU
  2,053,743,332 processor cycles
  864,022,384 bytes consed

Writing to stream a little bit slower, so we'll take as a base-line the result from render-concat:

POFTHEDAY> (defun render-stream (title items)
             "This function does not do proper HTML escaping."
             (flet ((to-string (value)
                      (format nil "~A" value)))
               (with-output-to-string (out)
                 (write-string "<title>" out)
                 (write-string (to-string title) out)
                 (write-string "</title><ul>" out)
                 
                 (loop for item in items
                       do (write-string "<li>" out)
                          (write-string (to-string item) out)
                          (write-string "</li>" out))
                 (write-string "</ul>" out))))
WARNING: redefining POFTHEDAY::RENDER-STREAM in DEFUN
RENDER-STREAM
POFTHEDAY> (time
            (loop repeat 1000000
                  do (render-stream "Foo Bar"
                                    '("One" "Two" "Three"))))
Evaluation took:
  1.208 seconds of real time
  1.214637 seconds of total run time (1.196847 user, 0.017790 system)
  [ Run times consist of 0.102 seconds GC time, and 1.113 seconds non-GC time. ]
  100.58% CPU
  2,667,477,282 processor cycles
  863,981,472 bytes consed

By, the way, I tried to use str:replace-all for escaping < and > symbols in the handwritten version of the render-concat function. But its performance degraded dramatically and became 36 microseconds.

str:replace-all uses cl-ppcre for text replacement.

What should I use instead?

Alexander Artemenkospinneret

· 3 days ago

Spinneret is a sexp based templating engine similar to cl-who, reviewed in post number #0075. Today we'll reimplement the snippets from the cl-who post and I'll show you a few features I'm especially like in Spinneret.

The first example is very simple. It is almost identical to cl-who, but more concise:

POFTHEDAY> (spinneret:with-html-string
             (:body
              (:p "Hello world!")))
"<body>
 <p>Hello world!
</body>"

Next example in the cl-who post showed, how to escape values properly to protect your site from JavaScript Injection attacks. With Spinneret, you don't need this, because it always escapes the values.

But if you really need to inject the HTML or JS into the page, then you have to use raw mode:

POFTHEDAY> (defclass user ()
             ((name :initarg :name
                    :reader get-name)))

POFTHEDAY> (let ((user (make-instance
                        'user
                        :name "Bob <script>alert('You are hacked')</script>")))
             (spinneret:with-html-string
               (:div :class "comment"
                     ;; Here Spinneret protects you:
                     (:div :class "username"
                           (get-name user))
                     ;; This way you can force RAW mode.
                     ;; DON'T do this unless the value is from the
                     ;; trusted source!
                     (:div :class "raw-user"
                           (:raw (get-name user))))))
"<div class=comment>
 <div class=username>
  Bob &lt;script&gtalert('You are hacked')&lt;/script&gt
 </div>
 <div class=raw-user>Bob <script>alert('You are hacked')</script>
 </div>
</div>"

With cl-who you might misuse str and esc functions. But with Spinneret there is less probability for such a mistake.

Another cool Spinneret's feature is its code walker. It allows mixing usual Common Lisp forms with HTML sexps. Compare this code snippet with the corresponding part from cl-who post:

POFTHEDAY> (let ((list (list 1 2 3 4 5)))
             (spinneret:with-html-string
               (:ul
                (loop for item in list
                      do (:li (format nil "Item number ~A"
                                      item))))))
"<ul>
 <li>Item number 1
 <li>Item number 2
 <li>Item number 3
 <li>Item number 4
 <li>Item number 5
</ul>"

We don't have to use wrappers like cl-who:htm and cl-who:esc here.

Finally, let's compare Spinneret's performance with Zenekindarl, reviewed yesterday:

POFTHEDAY> (declaim (optimize (debug 1) (speed 3)))

POFTHEDAY> (defun render (title items)
             (spinneret:with-html-string
               (:h1 title
                    (:ul
                     (loop for item in items
                           do (:li item))))))

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render "Foo Bar"
                             '("One" "Two" "Three"))))
Evaluation took:
  4.939 seconds of real time
  4.950155 seconds of total run time (4.891959 user, 0.058196 system)
  [ Run times consist of 0.078 seconds GC time, and 4.873 seconds non-GC time. ]
  100.22% CPU
  10,905,720,340 processor cycles
  991,997,936 bytes consed

Sadly, but in this test Spinneret 3 times slower than Zenekindarl and CL-WHO. Probably that is because it conses more memory?

@ruricolist, do you have an idea why does Spinneret 3 times slower than CL-WHO?

Alexander Artemenkosecret-values

· 6 days ago

This library can be useful for anybody who is writing services which logs their errors with backtraces. It will protect you from leaking sensitive data like passwords and tokens.

For example, let's pretend we have some code which authenticates to a database with a password. At some moment and error can happen and when you log the backtrace, the password will be logged as well:

POFTHEDAY> (defun authenticate (password)
             (format t "Authenticating with ~A"
                     password)
             (sb-debug:print-backtrace :count 3))

POFTHEDAY> (defun bar (password)
             (authenticate password))

POFTHEDAY> (bar "The Secret Password")

Authenticating with The Secret Password

Backtrace for: #<SB-THREAD:THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1003692013}>
0: (AUTHENTICATE "The Secret Password")
1: (BAR "The Secret Password")
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (BAR "The Secret Password") #<NULL-LEXENV>)

The secret-values allows to wrap the secret value into the object and retrieve the real value as needed.

POFTHEDAY> (secret-values:conceal-value "The Secret Password" :name "password")
#<SECRET-VALUES:SECRET-VALUE password {100450B623}>

POFTHEDAY> (secret-values:reveal-value *)
"The Secret Password"

Here how we can use it in our example. Pay attention to the backtrace. Now it does not contain the password and such backtrace can be written into the file or sent for diagnostic to the developer:

POFTHEDAY> (defun authenticate (password)
             (format t "Authenticating with ~A"
                     (secret-values:reveal-value password))
             (sb-debug:print-backtrace :count 3))

POFTHEDAY> (let ((pass (secret-values:conceal-value "The Secret Password")))
             (bar pass))

Authenticating with The Secret Password

Backtrace for: #<SB-THREAD:THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1003692013}>
0: (AUTHENTICATE #<SECRET-VALUES:SECRET-VALUE  {10043ABB23}>)
1: (BAR #<SECRET-VALUES:SECRET-VALUE  {10043ABB23}>)
2: ((LAMBDA ()))

I definitely will use it! And you should too!

By the way, does somebody know something about the author Thomas Bakketun and his company Copyleft? Seems they are using the Common Lisp in their stack.

Alexander Artemenkovcr

· 7 days ago

A few days ago, I tried to review a cl-vcr - a library which should remember and replay HTTP calls in your tests. But unfortunately it didn't work.

But Vincent "vindarel" did a good job, finding the similar project called vcr. It is not in Quicklisp, but can be downloaded from GitHub or Ultralisp:

https://github.com/tsikov/vcr

Today we'll check if vcr will work for remembering our HTTP calls.

First, let's make Drakma understand that application/json is a text format. Thanks to the @vseloved for this tip!

POFTHEDAY> (push '("application" . "json")
                 drakma:*text-content-types*)
(("application" . "json") ("text"))

POFTHEDAY> (drakma:http-request "https://httpbin.org/delay/5")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7371-a16e828d5dc4cb52867d2d09\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/5\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
((:DATE . "Thu, 10 Sep 2020 18:41:58 GMT") (:CONTENT-TYPE . "application/json")
 (:CONTENT-LENGTH . "360") (:CONNECTION . "close")
 (:SERVER . "gunicorn/19.9.0") (:ACCESS-CONTROL-ALLOW-ORIGIN . "*")
 (:ACCESS-CONTROL-ALLOW-CREDENTIALS . "true"))
#<PURI:URI https://httpbin.org/delay/5>
#<FLEXI-STREAMS:FLEXI-IO-STREAM {100238A0A3}>
T
"OK"

Now it is time to see if our requests will be cached:

POFTHEDAY> (time
            (vcr:with-vcr "foo"
              (drakma:http-request "https://httpbin.org/delay/10")))
Evaluation took:
  10.849 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7b55-4ceacc38a3d473a1e8ce9f01\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

;; Second call returns immediately!
POFTHEDAY> (time
            (vcr:with-vcr "foo"
              (drakma:http-request "https://httpbin.org/delay/10")))
Evaluation took:
  0.001 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7b55-4ceacc38a3d473a1e8ce9f01\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

Seems the library works. But it does not support multiple values and it will break you application if it uses status code or headers, returned as the second and third values.

This is strange because I see in it's code an attempt to handle multiple values :/

Now, how about making it work with Dexador? To do this, we have to rebind the vcr:*original-fn-symbol* variable:

POFTHEDAY> (let ((vcr:*original-fn-symbol* 'dexador:request))
             (time
              (vcr:with-vcr "foo"
                (dex:get "https://httpbin.org/delay/10"))))
Evaluation took:
  10.721 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7d84-7de184b7a8524404e7ecc234\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
POFTHEDAY> (let ((vcr:*original-fn-symbol* 'dexador:request))
             (time
              (vcr:with-vcr "foo"
                (dex:get "https://httpbin.org/delay/10"))))
Evaluation took:
  0.001 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7d84-7de184b7a8524404e7ecc234\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

Ups! Why did we send "Drakma" in the User-Agent header??? Let's recheck without the vcr wrapper:

POFTHEDAY> (dex:get "https://httpbin.org/delay/10")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7e04-fed39a80da9ac640b6835a00\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
((:DATE . "Thu, 10 Sep 2020 19:27:10 GMT") (:CONTENT-TYPE . "application/json")
 (:CONTENT-LENGTH . "361") (:CONNECTION . "close")
 (:SERVER . "gunicorn/19.9.0") (:ACCESS-CONTROL-ALLOW-ORIGIN . "*")
 (:ACCESS-CONTROL-ALLOW-CREDENTIALS . "true"))
#<PURI:URI https://httpbin.org/delay/10>
#<FLEXI-STREAMS:FLEXI-IO-STREAM {1006A2DB43}>
T
"OK"

Hmm, but if we'll restart our lisp process and check it on the fresh, the result will be different (and correct):

POFTHEDAY> (dex:get "https://httpbin.org/delay/10")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Content-Length\": \"0\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Dexador/0.9.14 (SBCL 2.0.8); Darwin; 19.5.0\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7ef4-ede1ef0036cd44c08b326080\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
#<HASH-TABLE :TEST EQUAL :COUNT 7 {1004BD1153}>
#<QURI.URI.HTTP:URI-HTTPS https://httpbin.org/delay/10>
#<CL+SSL::SSL-STREAM for #<FD-STREAM for "socket 192.168.43.216:63549, peer: 3.221.81.55:443" {1003F79823}>>

Oh, seems, vcr is always calling dexador:http-request, because that is what it does on the top level:

(defparameter *original-fn-symbol* 'drakma:http-request)

;; The symbol original-fn is internal for the package so
;; no name conflict is possible.
(setf (symbol-function 'original-fn)
      (symbol-function *original-fn-symbol*))

Also, I found the same problem as with the original cl-vcr - this library does not use unwind-protect and in case if some error will be signalled, it will break the original drakma:http-request function :(

To finalize, I think it can be used by those who are using Drakma if somebody will fix how the multiple values are handled and original function restoration.

Alexander Artemenkofunction-cache

· 8 days ago

Yesterday I've reviewed fare-memoization and decided to tell you about the library I'm using for memoization instead.

The main features are ability to set TTL and an extendable caching protocol which allows to use different kinds of caches.

For example, here we'll use LRU cache which will remember only 3 results:

POFTHEDAY> (function-cache:defcached (foo :cache-class 'function-cache:lru-cache
                                          :capacity 3)
               (param)
             (format t "Not cached, returning the value: ~A~%" param)
             param)

POFTHEDAY> (foo 1)
Not cached, returning the value: 1
1

;; Now the value returned from the cache:
POFTHEDAY> (foo 1)
1

;; Let's fill the cache:
POFTHEDAY> (foo 2)
Not cached, returning the value: 2
2
POFTHEDAY> (foo 3)
Not cached, returning the value: 3
3
POFTHEDAY> (foo 4)
Not cached, returning the value: 4
4
POFTHEDAY> (foo 5)
Not cached, returning the value: 5
5

;; Value for 1 was evicted from the cache:
POFTHEDAY> (foo 1)
Not cached, returning the value: 1
1

And here is how we can set TTL and make the function result remembered for 5 seconds:

POFTHEDAY> (function-cache:defcached (foo :timeout 5)
               ()
             (let ((ts (local-time:now)))
               (format t "Not cached, returning the value: ~A~%" ts)
               ts))

POFTHEDAY> (foo)
Not cached, returning the value: 2020-09-09T22:36:05.630085+03:00
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
Not cached, returning the value: 2020-09-09T22:36:10.767777+03:00
@2020-09-09T22:36:10.767777+03:00

Sometimes it can be very convenient to cache rarely changed data this way.

Alexander Artemenkofare-memoization

· 9 days ago

This library is used by cl-vcr, reviewed yesterday.

Previously I've used another library for caching function results and fare-memoization seems interesting because it allows to "memoize" any function unless it is inlined.

Also, this "memoization" effect can be undone:

POFTHEDAY> (defun foo (a b)
             "Waits 5 seconds and multiplies a and b."
             (sleep 5)
             (* a b))

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.003 seconds of real time

6

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.005 seconds of real time
  
6

POFTHEDAY> (fare-memoization:memoize 'foo)

;; This call will cache it's result:
POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.004 seconds of real time
  
6

;; And next call will return immediately:
POFTHEDAY> (time (foo 2 3))
Evaluation took:
  0.000 seconds of real time
  
6

;; Now we'll undone the effect:
POFTHEDAY> (fare-memoization:unmemoize 'foo)

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.005 seconds of real time
  
6

There is also a macro to define memoized functions and apply/funcall and remember results. The only thing I miss is the ability to cache results for a given amount of time.

Read the documentation, @ngnghm did a very good job!

Alexander Artemenkocl-vcr

· 10 days ago

This system provides a simple macro which will remember all HTTP requests. Results are stored to the disk and will be reused. This should be useful if you need to rerun your integration tests frequently.

The README is short and only say that cl-vcr was inspired by https://github.com/vcr/vcr

By the way, cl-vcr is not in Quicklisp. Here is the link to the repository:

https://github.com/kidd/cl-vcr

Let's try it!

;; CL-VCR stores it's data in /tmp/vcr/, but does
;; not create it itself :(
POFTHEDAY> (ensure-directories-exist "/tmp/vcr/")


POFTHEDAY> (time
            (cl-vcr:with-vcr "the-tape"
              (drakma:http-request "https://httpbin.org/delay/10")))
Evaluation took:
  10.859 seconds of real time
  0.037955 seconds of total run time (0.025274 user, 0.012681 system)
  0.35% CPU
  12 lambdas converted
  23,975,316,800 processor cycles
  5 page faults
  1,176,304 bytes consed
  
#(123 10 32 32 34 97 114 103 115 34 58 32 123 125 44 32 10 32 32 34 100 97 116
  97 34 58 32 34 34 44 32 10 32 32 34 102 105 108 101 115 34 58 32 123 125 44
  32 10 32 32 34 102 111 114 109 34 58 32 123 125 44 32 10 32 32 34 104 101 97
  100 101 114 115 34 58 32 123 10 32 32 32 32 34 65 99 99 101 112 116 34 58 32
  34 42 47 42 34 44 32 10 32 32 32 32 34 72 111 115 116 34 58 32 34 104 116 116
  112 98 105 110 46 111 114 103 34 44 32 10 32 32 32 32 34 85 115 101 114 45 65
  103 101 110 116 34 58 32 34 68 114 97 107 109 97 47 50 46 48 46 55 32 40 83
  66 67 76 32 50 46 48 46 56 59 32 68 97 114 119 105 110 59 32 49 57 46 53 46
  48 59 32 104 116 116 112 58 47 47 119 101 105 116 122 46 100 101 47 100 114
  97 107 109 97 47 41 34 44 32 10 32 32 32 32 34 88 45 65 109 122 110 45 84 114
  97 99 101 45 73 100 34 58 32 34 82 111 111 116 61 49 45 53 102 53 54 56 98 57
  48 45 98 55 102 53 56 99 98 48 52 57 57 55 51 51 53 48 100 52 48 56 52 55 55
  48 34 10 32 32 125 44 32 10 32 32 34 111 114 105 103 105 110 34 58 32 34 51
  49 46 49 55 51 46 56 48 46 55 34 44 32 10 32 32 34 117 114 108 34 58 32 34
  104 116 116 112 115 58 47 47 104 116 116 112 98 105 110 46 111 114 103 47 100
  101 108 97 121 47 49 48 34 10 125 10)

POFTHEDAY> (time
            (cl-vcr:with-vcr "the-tape"
              (drakma:http-request "https://httpbin.org/delay/10")))
; Debugger entered on #<SIMPLE-TYPE-ERROR expected-type: SB-IMPL::FUNCTION-NAME
;                     datum: (LAMBDA () :IN DRAKMA::MAKE-SSL-STREAM)>

As you can see, here we have two problems:

  • cl-vcr does not work;
  • drakma is not able to decode httpbin.org's JSON response (honestly, I tried different arguments to http-request.

Fortunately, there is cool Dexador, which "just works" and a hack to make cl-vcr use it. But "ups!" it does not work either, because cl-vcr tries to remember all returned values, including SSL stream and associated CFFI structure of the networking socket:

POFTHEDAY> (time
            (let ((cl-vcr::*http-call* 'dex:request))
              (cl-vcr:with-vcr "the-tape"
                (dex:get "https://httpbin.org/delay/10"))))
; Debugger entered on #<CL-STORE:STORE-ERROR {100C4C3E73}>

;; This is what dex:get returns as it's values:
POFTHEDAY> (dex:get "https://httpbin.org/delay/10")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Content-Length\": \"0\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Dexador/0.9.14 (SBCL 2.0.8); Darwin; 19.5.0\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f568fb6-f74ff20069c9dca0a0b0c760\"
  }, 
  \"origin\": \"31.173.80.7\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
#<HASH-TABLE :TEST EQUAL :COUNT 7 {100C4BBC93}>
#<QURI.URI.HTTP:URI-HTTPS https://httpbin.org/delay/10>
#<CL+SSL::SSL-STREAM for #<FD-STREAM for "socket 192.168.43.216:64553, peer: 35.170.21.246:443" {100C4AE583}>>

We can overcome these difficulties by creating a wrapper to make HTTP requests and return only the result.

First call returns in 10 seconds:

POFTHEDAY> (defun http-get (url)
             (values (dex:get url)))

POFTHEDAY> (time
            (let ((cl-vcr::*http-call* 'http-get))
              (cl-vcr:with-vcr "the-tape"
                (http-get "https://httpbin.org/delay/10"))))
Evaluation took:
  10.175 seconds of real time
  0.020157 seconds of total run time (0.013977 user, 0.006180 system)
  0.20% CPU
  52 lambdas converted
  22,465,739,006 processor cycles
  4,203,120 bytes consed
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Content-Length\": \"0\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Dexador/0.9.14 (SBCL 2.0.8); Darwin; 19.5.0\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5692a6-fde6da521dce37dc2983bb9e\"
  }, 
  \"origin\": \"31.173.80.7\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

But second call returns immediately:

POFTHEDAY> (time
            (let ((cl-vcr::*http-call* 'http-get))
              (cl-vcr:with-vcr "the-tape"
                (http-get "https://httpbin.org/delay/10"))))
Evaluation took:
  0.005 seconds of real time
  0.005484 seconds of total run time (0.004814 user, 0.000670 system)
  100.00% CPU
  26 lambdas converted
  12,198,056 processor cycles
  1,996,128 bytes consed
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Content-Length\": \"0\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Dexador/0.9.14 (SBCL 2.0.8); Darwin; 19.5.0\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5692a6-fde6da521dce37dc2983bb9e\"
  }, 
  \"origin\": \"31.173.80.7\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

There is another problem with cl-vcr - it does not use unwind-protect to run unmemoize. That is why it applied memoization patch to the dex:request function, but didn't roll it back on the error.

What could I say? CL-VCR is a good example of a really bad implementation of a nice idea :)

Alexander Artemenkotrivial-left-pad

· 11 days ago

Did you hear the story of how one developer broke thousand JavaScript libraries by removing 11 lines of code from NPM?

Now we can to repeat this feat because we have our own left-pad for Common Lisp! :)

This library brings only one function, which adds some spaces, to make a string of given length:

POFTHEDAY> (trivial-left-pad:left-pad "Foo" 16)
"             Foo"

POFTHEDAY> (trivial-left-pad:left-pad "Bar" 16)
"             Bar"

POFTHEDAY> (trivial-left-pad:left-pad "Blah" 16)
"            Blah"

POFTHEDAY> (trivial-left-pad:left-pad "Minor" 16)
"           Minor"

POFTHEDAY> (trivial-left-pad:left-pad "Hello world!" 16)
"    Hello world!"

You also can specify a custom padding as a character or a string:

POFTHEDAY> (trivial-left-pad:left-pad "Hello world!" 16 ".")
"....Hello world!"

POFTHEDAY> (trivial-left-pad:left-pad "Hello world!" 16 #\.)
"....Hello world!"

POFTHEDAY> (trivial-left-pad:left-pad "Hello world!" 16 ".!")
".!.!Hello world!"

POFTHEDAY> (trivial-left-pad:left-pad "Hello world!" 16 "->")
"->->Hello world!"

Of cause, this library is useful only if you need padding from more than one character. In other cases it is much easier to use standard format function:

POFTHEDAY> (format nil "~16@A" "Hello world!")
"    Hello world!"

POFTHEDAY> (format nil "~16,,,'_@A" "Hello world!")
"____Hello world!"

POFTHEDAY> (format nil "~16,,,'+@A" "Hello world!")
"++++Hello world!"

;; If you want to pass padding in runtime:

POFTHEDAY> (format nil "~v,,,v@A" 16 #\+ "Hello world!")
"++++Hello world!"

Nicolas HafnerComing Alive - September Kandria Update

· 12 days ago

header
Another month already. Fortunately there's a lot of stuff to talk about for Kandria this time around, so I hope you're ready for a beefy summary!

This month was originally intended to be focused on marketing and recruitment, but for more reasons than one that's not entirely how it went down after all. The biggest reason among the bunch being that it has proven really hard for me to concentrate on that - they're topics I have no experience with, so I don't feel very comfortable dealing with them at all. Regardless, there's been a few things I've done to help in that regard:

There is now a lengthy game design document that should hopefully give a good idea of what the game should be and should be about. It's mostly meant as a communication tool for future team members, to help them get up to speed on the project, and for potential team members to evaluate whether this project is something for them. If you have a read through it, I would appreciate your thoughts on it a lot! Being in an opinion vacuum doesn't help with creativity.

Next I started working on an official job listing. It's not quite done yet and I want to run it by a few people before I get it out there, but if you are or know pixel artists or writers, I'd appreciate it tremendously if you could keep an eye open for the listing. I'll make another announcement about it on all the channels once it's out. Edit: the job listing is now out: https://kandria.com/team-search.html?a

I've also started a thread on some forums to try and spread awareness of the game, but I'm worrying that I'm spreading myself too thin and can't tend to all of the outlets as much as I'd like. There's already email, Twitter, and Discord to take care of besides that. With Kandria not being a full-time job yet, I'm not sure how much time I should be spending on the social media channels, rather than spending it on development. Maybe I should reserve a day for it every week? Either way, top priority for the coming few weeks will be finding new team members, and I'll definitely have to invest some more energy to get that going.

I've also made some good progress on the code and art side: first I've implemented some more dynamic interactions to make the environment feel more alive:

These, especially the under water physics, still need some work in the future, but for only having spent a single day on them they already look quite promising. I have a few more ideas for dynamic interactions like that that I want to try and implement soon, too. All in all this should really help to make the world feel more alive and real, rather than being just a static map of tiles.

Sort of adjacent to this I created a custom distortion effect that'll be useful for indicating damage and death:

Then there were mechanical changes to the game: so far you could climb up walls indefinitely. I've decided to change this and implement a simple stamina system, as this will allow greater control over where the player can or cannot go, thus making it possible to block off certain routes and regions until later. It should also provide for more interesting platforming challenges and interactions with other elements like the rope.

Finally there were a bunch of good bugfixes thanks to public feedback! These aren't rolled out in the latest downloadable prototype yet, but they'll be in the next one, which I hope to release sometime this month. I've also automated deployment almost fully, allowing me to upload new updates at the push of a button. For now I'm keeping the public prototypes at a staggered release schedule, with a separate rolling release tester group on Steam. I'll provide more info about the Steam testing group once I have a better bug reporting system in place.

Then I've gotten back to re-integrating the dialog system. This is now pretty much done, the only missing component is the quest system that controls what dialog can be active at what point and things like that. I'll probably get to that next once I've rounded up some more issues with audio, though more on that in a second. The dialog system I have in Kandria is pretty powerful, and I've written a lengthy bit about it in the weekly newsletter. I also started working on profile animations for that:

profile-1profile-2 profile-3profile-4

They'll need some more work though, as I'm not convinced they fit very well into the dialog box as I've got it so far.

dialogbox

I think I'll have to try out anti-aliasing to smoothen the animations out some more. Maybe that'll make it feel more at home with the pretty crisp textbox. That's not very high on my list of priorities though, so I'll keep it for another time.

Finally, after months of pretty painful debugging and coding, I've made a breakthrough with my audio engine! It's now conceptually complete and just needs some good integration testing within Kandria. The good news is that, aside from a missing reverb implementation, it should offer everything I need for Kandria, and more, so using it for all of my future projects is definitely on the table. Since this has been such a long and arduous journey, I wanted to take some good time to explain the system. If you're interested in that, you can read about it here. Suffice to say, the next prototype release will finally have sound!

It'll be a bit before the sound in Kandria will be custom and accompanied by nice, composed music specifically for the game, though. Music and sound is something I've been thinking about for a long time, but I'm purposefully putting it off for much later, as I know it needs to fit the places, story, and characters, all of which have not been sufficiently worked out yet.

Looking back at the roadmap that I published in June, it seems like I'm getting ahead pretty well despite the many issues that propped up along the way. A lot of the big blockers have already been fixed, and with a bigger team the rest should get ahead pretty well, too. I don't want to jinx it, but it's looking like the March deadline for the vertical slice is doable!

Alright, so to summarise the plan for this month: complete the job listing, re-integrate the quest system, add some preliminary sounds and music, improve the bug reporting, and release the 0.0.3 demo. We'll see how much of that, if not more, I get done by next month.

If you want to get the weekly updates with more details on what's going on until then, subscribe to the newsletter!

Alexander Artemenkoglobal-vars

· 12 days ago

This system is a compatibility layer for defining global variables. Global variables cannot be dynamically bound and sometimes is faster than variables defined with defvar or defparameter.

Also, when you are using globals-vars to define a variable, you tell the user of the library that this variable is not intended to by dynamically bound.

Here is a test for speed, comparing access to standard variable and global variable:

POFTHEDAY> (declaim (optimize (debug 1) (speed 3)))

POFTHEDAY> (defvar *global* 0)
*GLOBAL*

POFTHEDAY> (global-vars:define-global-var -global- 0)
-GLOBAL-

POFTHEDAY> (time (loop repeat 1000000000
                       do (incf *global*)))
Evaluation took:
  2.339 seconds of real time
  2.339325 seconds of total run time (2.336514 user, 0.002811 system)
  100.00% CPU
  5,164,301,132 processor cycles
  0 bytes consed

POFTHEDAY> (time (loop repeat 1000000000
                       do (incf -global-)))
Evaluation took:
  1.560 seconds of real time
  1.560328 seconds of total run time (1.558862 user, 0.001466 system)
  100.00% CPU
  3,444,078,626 processor cycles
  0 bytes consed

As you can see, accessing of variable, defined as global is almost twice faster on SBCL.

There is also macros define-global-var* and define-global-parameter*. They will define variables which will not be available in compile-time. Why does somebody might want this?

Nicolas HafnerHarmony 2 - Confession 90

· 12 days ago

header
It turns out that sound processing is pretty difficult. I've been hacking away at an almost from-scratch rewrite of Shirakumo's sound systems for the past few months and it's caused a lot of anguish.

Now, Harmony is not a new system. It dates back quite a few years, and I had even written another article on it previously. However, this previous version had several serious flaws and problems, some of which penetrating all the way through the audio stack. With the rewrite I'm however now much more confident in the quality and usability of the system.

First though, a bit of terminology: in digital audio processing, audio is represented as a sequence of samples; regularly recorded amplitudes of the audio signal. These samples are recorded at a constant rate, the "sample rate," which often is either 44.1kHz or 48kHz. Often each sample is represented as a float going from -1 to +1, and multiple such sample sequences are combined to form the signal for as many channels as you need (stereo, surround, etc.) When processing audio data, a limited sequence of samples is kept in a buffer, which processors can then operate on.

The initial problem with the system was one of resampling: the system was written with the assumption that one could keep a constant samplerate throughout the entire audio processing pipeline. This, however, turned out to not be suitable. The issue manifested itself on Windows, where the output backend could require a different samplerate to the one the system was initially configured for. Thus, at least at the end-points, resampling would be required.

This immediately lead to another problem though: the system was also written with the assumption that every part of the pipeline could consume and produce a full audio buffer every time it was run. However, with resampling, border issues appear and it's not always possible to consume the full input buffer. This issue permeates throughout the processing pipeline, as now the final processor cannot consume all data, and so when the system is run next, the processor before the last cannot produce a full buffer as it would overwrite data.

Ultimately though, the fixed samplerate and fixed buffer size design lead to a restriction that made it impossible to represent certain effects like a speed change, which would produce and consume samples at different rates. And so, pretty much everything had to be rewritten to work with this in mind. To spare you the troublesome process of figuring out a design, let's just jump to what the system is like now:

At the most basic level resides the bip-buffer interface, which implements a lockless bipartite buffer. It's lockless so that one thread can write, and another can read from it simultaneously. It's bipartite so that the regions it hands out are always consecutive regions of memory, rather than wrapping around like in a ring buffer. This interface is implemented by buffers and packs. buffers represent internal audio samples of one channel in float format, whereas packs represent external audio samples in any format, with any number of channels.

Then there's the parts that actually perform audio processing. These are called segments, and follow a generic interface that allows them to do their work, and also allows them to be introspected. Namely they each have a number of input fields, a number of output fields, and a number of parameter fields. To the input and output fields you can attach a buffer, which will cause the segments to exchange data. Assembling a network is then just a matter of creating the segments, creating a buffer for each connection, and then setting them at the appropriate in/out fields.

At the endpoints, where you need to exchange data with other systems such as file decoders or device drivers, you'll probably want to make use of the unpacker and packer segments, which perform the necessary encoding to translate between the float buffers and the compact packs. These segments will also perform sample rate conversion as necessary.

Since we have proper bip buffers connecting everything, a segment can now consume and produce at a variable rate without needing to be aware of the rates going on in the rest of the system. The rates will automatically propagate through the system as the buffers are updated.

Now, all of this behaviour, including many practical standard segments are implemented in a C library called libmixed. Audio has some pretty severe latency restrictions, and that's why, with great pain, I decided to implement the bulk of the audio processing in C, rather than Lisp. This has cost me a lot of time, but I still think the performance gains are worth it, or I would have had to spend similar, if not more time, trying to match the performance with Lisp code. I hope that this kind of thing will no longer be necessary at some point in the future, but for now this is where we are.

Anyway, being implemented in C also means it can be useful for people outside of Lisp, and I really do hope that others will take advantage of libmixed, as I think it has a lot of useful work behind it. To my knowledge there's currently no free (as in BSD) and capable audio processing system out there. The library also offers a plugin and reflection/introspection API so that one could build a GUI that can represent segments and buffers in a very generic fashion, allowing users to easily plug together processing networks.

Now, one level above libmixed sits cl-mixed, the Lisp bindings library that takes care of the low level stuff and wraps it all in a nice Lisp interface. It also takes care of offering some support structures where needed, such as managing the input locations when dealing with variable input segments such as mixers. It also offers a ton of extension systems for interacting with various file formats and playback backends:

  • ALSA Linux playback
  • CoreAudio macOS playback
  • FLAC FLAC file decoding
  • Jack JackAudio playback
  • OSS OSS playback (BSD)
  • PulseAudio Linux desktop playback
  • SDL2 SDL2 integration if you're already using SDL2
  • WASAPI Windows Vista+ playback
  • WAV WAV file decoding
  • WinMM Windows 3.0+ playback
  • XAudio2 Windows 8+ playback
  • mpg123 MP3 decoding
  • out123 Cross-platform playback (C blob)

I'd like to add more decoders, and at some point also input for the various operating system backends, but for now this is more than plenty. Some of the backends still have issues (WinMM, XAudio2, CoreAudio), which I have spent a long time trying to figure out already, so far unsuccessful. I'm not too bothered about WinMM and XAudio2, but CoreAudio definitely needs to be made to work properly soon.

The reason these backends are implemented in Lisp is so that there's no additional dependencies on shared libraries that might be versioned and interact poorly when deployed. Since the actual work performed in their respective segment amounts to requesting a buffer region and performing one call, the performance impact from it should also be entirely negligible.

cl-mixed also offers a virtual segment that allows you to implement a segment in Lisp and integrate it into a standard pipeline. This is possible thanks to the standardised architecture in libmixed, and can be very useful to experiment with effects very quickly. If I ever intend on developing a new effects segment, I'll definitely implement it in Lisp first to take advantage of rapid prototyping, before lowering it down to C if performance should become an issue.

On that note, cl-mixed actually uses static-vectors to implement the backing storage of packs and buffers, as well as all of the bip-buffer protocol. This means that you can interact with packs and buffers from Lisp as if they were normal Lisp arrays, without ever having to worry about FFI.

That said, cl-mixed will not do buffer management or resource management in general for you. You'll still have to manually create and free segments and buffers and make sure they're connected. You'll also have to run the mixing loop yourself and make sure you do that often enough to not cause stuttering.

This is where Harmony steps in. Being the high-level component, it imposes a bit of architecture on you, but in turn takes care of a lot of lower level plumbing. In effect, with Harmony you can perform playback as easily as:

(harmony:start (harmony:make-simple-server))
(harmony:play "music.mp3" :mixer :music :loop T)
(harmony:play "effect.wav" :mixer :effect :location '(10 0 0))

It'll take care of detecting the appropriate backend for your platform, setting up channel conversion and basic mixing infrastructure, allocating and re-using buffers, automatically cleaning up when a sound source ends, and performing low-latency audio processing in the background.

It can also do fun stuff like automatically creating a network to apply effects to a source.

(harmony:play "music.wav" :mixer :music :effects
  '((mixed:speed-change :speed-factor 2.0)
    (mixed:pitch :pitch 0.5)))

Which would play the music at double the speed, but with a pitch correction applied so that the notes should still be the correct frequency.

Hopefully this will make it easy enough to use for games without having to worry about all the low level detail aspects. I'm going to find out how well this all works soon, as it's now at a stable enough state that I can start working it into Kandria.

If you're interested in using these systems or contributing to them, let me know! I'd be happy to provide assistance.

If you like my work in general and want to donate, you can do that too, either on GitHub Sponsors for recurring donations, or on Ko-Fi for one-time donations.

Thanks for reading!

Alexander Artemenkoconduit-packages

· 13 days ago

This system is pretty old. It does not have its own revision control and is hosted here. It provides the replacement for the defpackage macro. This replacement makes easy to "inherit" your package from another and to replace some symbols with your own.

For example, @stylewarning's cl-generic-arithmetic uses it to redefine some functions from cl package. It defines a new package which uses cl and reexports all symbols except some which are defined in by the cl-generic-arithmetic as generic functions.

Let's repeat this to make + a function generic!

POFTHEDAY> (org.tfeb.clc:defpackage cl-generic
             (:extends/excluding #:cl
                                 #:+)
             (:export #:+))

;; For simplicity, I'll define this operation as
;; binary. But for real implementation it should
;; support variadic arguments.
POFTHEDAY> (defgeneric cl-generic:+ (left right)
             (:method ((left number) (right number))
               (cl:+ left right))
             (:method ((left string) (right string))
               (concatenate 'string left right))
             (:method ((left string) (right number))
               (format nil "~A~A" left right)))

Now we can define another package which will use this generic function. Note, I'll just :use this new package instead of standard :cl package:

POFTHEDAY> (defpackage foo
             (:use :cl-generic))

POFTHEDAY> (in-package foo)

FOO> (+ 1 2)
3

FOO> (+ "Hello " "World!")
"Hello World!"

;; Other function are standard, becase they are inherited
;; from the standard package:
FOO> (- 5 3)
2

FOO> (- "Hello " "World!")
; Debugger entered on #<TYPE-ERROR expected-type: NUMBER datum: "Hello ">

By the way, you can get the same effect by using uiop:define-package. But it will be a little bit wordy:

POFTHEDAY> (uiop:define-package cl-generic2
             (:use #:cl)
             (:shadow #:+)
             (:reexport #:cl))
#<PACKAGE "CL-GENERIC2">

POFTHEDAY> (defgeneric cl-generic2:+ (left right)
             (:method ((left number) (right number))
               (cl:+ left right))
             (:method ((left string) (right string))
               (concatenate 'string left right))
             (:method ((left string) (right number))
               (format nil "~A~A" left right)))

POFTHEDAY> (defpackage foo2
             (:use :cl-generic2))

POFTHEDAY> (in-package foo)

POFTHEDAY> (in-package foo2)

FOO2> (+ 1 2)
3

FOO2> (+ "Hello " "World!")
"Hello World!"

FOO2> (- 5 3)
2

FOO2> (- "Hello " "World!")
; Debugger entered on #<TYPE-ERROR expected-type: NUMBER datum: "Hello ">

Probably I missed some of the conduit-packages features. Please, read its sources and tell me if you will find something interesting!

Leo ZovicA Bit More Work On Cl Vote

· 14 days ago

So I've done a bit more work on cl-vote. The main thing I've learned so far is...

House Still Sucks, and I'm Still Keeping It

This project started off with an attempt to use hunchentoot. Which is a fine server, with much to recommend it. I actually got a fair way through the prototyping process, and everything was going fairly well at that point. And then, I needed to switch machines for a bit. The new computer had this to say about my attempt to load it:

Unable to load any of the alternatives:
   ("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k"
    "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j"
    "libssl.so.1.0.1f" "libssl.so.1.0.1e" "libssl.so.1.0.1"
    "libssl.so.1.0.0q" "libssl.so.1.0.0" "libssl.so.0.9.8ze"
    "libssl.so.0.9.8" "libssl.so.10" "libssl.so.4" "libssl.so")
   [Condition of type CFFI:LOAD-FOREIGN-LIBRARY-ERROR]

Restarts:
 0: [RETRY] Try loading the foreign library again.
 1: [USE-VALUE] Use another library instead.
 2: [TRY-RECOMPILING] Recompile reload and try loading it again
 3: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload">.
 4: [ACCEPT] Continue, treating loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload"> as having been successful.
 5: [RETRY] Retry ASDF operation.
 --more--

Backtrace:
  0: (CFFI::FL-ERROR "Unable to load any of the alternatives:~%   ~S" ("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j" ...))
  1: (CFFI::TRY-FOREIGN-LIBRARY-ALTERNATIVES CL+SSL::LIBSSL ("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j" ...) NIL)
  2: ((FLET CFFI::%DO-LOAD :IN CFFI::%DO-LOAD-FOREIGN-LIBRARY) #<CFFI:FOREIGN-LIBRARY LIBSSL> CL+SSL::LIBSSL (:OR "libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" ..
  3: (CFFI:LOAD-FOREIGN-LIBRARY CL+SSL::LIBSSL :SEARCH-PATH NIL)
  4: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-2..
  5: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/reload.fasl" {1005..
  6: ((FLET SB-FASL::THUNK :IN LOAD))
  7: (SB-FASL::CALL-WITH-LOAD-BINDINGS #<CLOSURE (FLET SB-FASL::THUNK :IN LOAD) {7FD50D5AC88B}> #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp..
  8: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/rel..
  9: (LOAD #P"/home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/reload.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EX..
 10: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {1005B381EB}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
 11: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">)
 12: ((LAMBDA NIL :IN ASDF/ACTION:CALL-WHILE-VISITING-ACTION))
 13: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-m..
 14: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-method]
 15: ((:METHOD ASDF/PLAN:PERFORM-PLAN (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {100411E773}>) [fast-method]
 16: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
 17: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {100411E773}>) [fast-method]
 18: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :PLAN-CLASS NIL :PLAN-OPTIONS NIL) [fast-method]
 19: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :VERBOSE NIL)
 --more--

And once again, :house loaded and started without issue. Just like the last time I mentioned this, I have that library it's complaining about. And it's in a place perfectly consistent with being installed by nix or guix. And no amount of poking at cffi/sbcl configuration can get it loaded properly. So, if for no reason other than prototyping, there's absolutely a need for a Common Lisp-native web server.

The problem at this point is that I was basically a kid when I designed house. And I did it as part of a much more ambitious project that was actually the main goal, so the server itself got comparatively little of my brain time.

I'm very tempted to try again.

Maybe not from the ground up. There are a lot of hard-won bugfixes and #+/#- switches in that codebase, and I don't want to give up all that progress by going nuclear. But the way the handler/type system is built is less than stellar, sessions could use some touch-ups, and I could probably stand to be a bit more general in the handling of a few elegant flow points. Especially in the sense of providing better HTTP-client and/or websocket support. Im' not doing this now, but I've made a note to my future self.

Recovery Token

Now that I've got tomb ready to let me store passwords and password-like things in database without exposing the relevant plaintexts anywhere, I can use it to store a recovery token per user account.

The idea is that, since I'm using an authenticator app to log users in, and those authenticator apps are typically on a phone somewhere, they might need a way of accessing their account without having access to their phone. You can see the relevant changes in this commit.

To summarize:

  1. We generate a recovery token when a user is created
  2. There is a new handler that expires the old token and generates a new one for the current user
  3. We now accept either the authenticator challenge result or a users' recovery token to log in that user, instead of just the challenge result.
  4. If the correct recovery token is given, the users' recovery token is expired and given a new one as part of the login process. Specifically, by redirecting to that expire-and-create page above.

That does it for now. The next chunk of my work is going to focus first on a hammer-protection system, and then on going through the full usage path of an election. From creation, to voting to tallying results.

As always, I'll let you know how it goes.

Alexander Artemenkocl-ltsv

· 17 days ago

This system implements an LTSV logs parser and serializer. LTSV is based on TSV format but each field has a name. This lets us easily add new fields and to process logs in a manageable way:

POFTHEDAY> (cl-ltsv:alist-ltsv '(("message" . "Hello world!")
                                 ("request_id" . 100500)))
"message:Hello world!	request_id:100500"

POFTHEDAY> (cl-ltsv:parse-line *)
(("message" . "Hello world!")
 ("request_id" . "100500"))

LTSV is based on TSV format which has some escaping rules for tabs, newlines and backslashes, but LTSV FAQ says forget about escaping, we don't need it for our access logs.

I think this decision makes LTSV unusable for general-purpose logs.

For example, if you have newlines or tabs in the logged value, a log will be broken:

POFTHEDAY> (concatenate 'string
                        "Hello"
                        '(#\Newline #\Tab)
                        "World!")
"Hello
	World!"

;; This call should produce a single line,
;; replacing a newline with \n and tab with \t:
POFTHEDAY> (cl-ltsv:alist-ltsv (list (cons "message" *)))
"message:Hello
	World!"

;; Parsing does not process escaped symbols either:

POFTHEDAY> (cl-ltsv:parse-line "message:Hello\\n\\tWorld!")
(("message" . "Hello\\n\\tWorld!"))

That is all I have for today. Probably tomorrow we'll catch a more interesting library.

Alexander Artemenkosmug

· 18 days ago

This system provides a framework for building parsers in a functional way.

Smug parsers are lisp functions which can be combined together to process complex grammar. Actually, it can process anything, not only the text - any data source which can be read token by token is suitable.

Documentation on smug is extremely good! I'll how only the basics. Good job, @drewcrampsie. Read the official tutorial to learn in deep how this sytem works!

Today we'll create a parser which will be able to transform texts like "3 days ago" into the local-time-duration:duration objects.

To start, let's create a simple parser which will match a digit character:

POFTHEDAY> (defun .digit ()
             (smug:.is #'digit-char-p))

POFTHEDAY> (smug:run (.digit)
                     "17 hours ago")
((#\1 . "7 hours ago"))

We can use .map to capture a sequence of digits matched to the parser:

POFTHEDAY> (smug:run (smug:.map 'list (.digit))
                     "17 hours ago")
(((#\1 #\7) . " hours ago")
 ((#\1)     . "7 hours ago"))

;; We also might produce strings:
POFTHEDAY> (smug:run (smug:.map 'string (.digit))
                     "17 hours ago")
(("17" . " hours ago")
 ("1"  . "7 hours ago"))

Now it is time to transform it into the number. I'll wrap all code into the parser function and use smug:.bind to process the captured values:

POFTHEDAY> (defun .integer ()
             (smug:.bind (smug:.map 'string (.digit))
                         (lambda (text)
                           (smug:.identity (read-from-string text)))))

POFTHEDAY> (smug:run (.integer)
                     "17 hours ago ")
((17 . " hours ago ")
 (1 . "7 hours ago "))

It is time to parse time units:

POFTHEDAY> (smug:run (smug:.prog1 (smug:.string-equal "hour")
                                  ;; This will "eat" the "s" letter
                                  ;; on the end of the plural form
                                  ;; if it is used:
                                  (smug:.string-equal "s"))
                    "hours ago")
(("hour" . " ago"))

;; Again, we'll want to convert the string into the keyword and to wrap
;; the parser into a function:

POFTHEDAY> (defun .unit ()
             (smug:.bind (smug:.prog1 (smug:.or (smug:.string-equal "hour")
                                                (smug:.string-equal "minute")
                                                (smug:.string-equal "second"))
                                      ;; This will "eat" the "s" letter
                                      ;; on the end of the plural form
                                      ;; if it is used:
                                      (smug:.or (smug:.string-equal "s")
                                                (smug:.identity nil)))
                         (lambda (text)
                           (smug:.identity (alexandria:make-keyword
                                            (string-upcase text))))))

POFTHEDAY> (smug:run (.unit)
                     "hours ago")
((:HOUR . " ago"))

And finally, we need a parser to process optional suffix pointing to the time in past:

POFTHEDAY> (defun .in-past-p ()
             (smug:.or (smug:.string-equal "ago")
                       (smug:.identity nil)))

POFTHEDAY> (smug:run (.in-past-p)
                     "ago")
(("ago" . ""))

POFTHEDAY> (smug:run (.in-past-p)
                     "some")
((NIL . "some"))

It is time to combine our parsers into a more complex one which will return a local-time-duration:

POFTHEDAY> (defun .whitespace ()
             (smug:.is #'member
                       '(#\Space #\Tab #\Newline)))

POFTHEDAY> (defun .duration ()
             (smug:.let* ((value (.integer))
                          (_ (.whitespace))
                          (unit (.unit))
                          (_ (.whitespace))
                          (in-past (.in-past-p)))
               (let* ((seconds
                        (* value
                           (ecase unit
                             (:hour (* 60 60))
                             (:minute 60)
                             (:second 1))
                           (if in-past
                               -1
                               1)))
                      (duration
                        (make-instance 'local-time-duration:duration
                                       :sec seconds)))
                 
                 (smug:.identity duration))))

;; A few checks if everything is OK:

POFTHEDAY> (smug:parse (.duration)
                       "17 hours ago")
#<LOCAL-TIME-DURATION:DURATION [0/-61200/0]  -17 hours>

POFTHEDAY> (smug:parse (.duration)
                       "5 minute ")
#<LOCAL-TIME-DURATION:DURATION [0/300/0]  5 minutes>

That is it for today. And again, to learn more, read SMUG's documentation. It is one of the best-documented Lisp systems I've ever seen:

http://smug.drewc.ca/smug.html

Thank you, @drewcrampsie!

Alexander Artemenkolist-named-class

· 19 days ago

This is the library by Michał "phoe" Herda. It extends CLOS allowing to use lists of symbols as class names:

POFTHEDAY> (list-named-class:defclass (:user :model) ()
             ())

POFTHEDAY> (list-named-class:defclass (:user :view) ()
             ())

POFTHEDAY> (list-named-class:defgeneric render (obj))

POFTHEDAY> (list-named-class:defmethod render ((obj (:user :view)))
             (format nil "Rendered User View"))

POFTHEDAY> (list-named-class:make-instance '(:user :view))
#<(:USER :VIEW) {10076F6CC3}>

POFTHEDAY> (render *)
"Rendered User View"

This can be useful when classes are defined using some macros. Not sure why somebody should prefer such class-names instead of symbols.

Here are some examples of list-named-class usage I found in the wild:

Alexander Artemenkotemporal-functions

· 20 days ago

This is a small library by @thebaggers allows you to define functions which work only specified amount of time. You can use it to define a named function or to create a lambda.

This will print a greeting only 10 seconds since definition:

POFTHEDAY> (temporal-functions:defun-t foo ()
             (temporal-functions:before (temporal-functions:seconds 10)
               (print "Hello Lisp World!")))

POFTHEDAY> (foo)
"Hello Lisp World!" 
"Hello Lisp World!"

POFTHEDAY> (foo)
"Hello Lisp World!" 
"Hello Lisp World!"

POFTHEDAY> (foo)
NIL

POFTHEDAY> (temporal-functions:expiredp (foo))
T

It is possible to create a function which starts doing something after the specified amount of time:

POFTHEDAY> (temporal-functions:tlambda ()
             (temporal-functions:after (temporal-functions:seconds 10)
               (print "Now I'm working!")))
#<CLOSURE (LAMBDA ()) {1001D5183B}>

POFTHEDAY> (funcall *)
NIL

POFTHEDAY> (funcall **)

"Now I'm working!" 
"Now I'm working!"

There are also other constructions like then, repeat, each, until and once. But I wasn't able to figure out the right way to use them. It would be wonderful if @thebaggers update the documentation!

Leo ZovicTomb And More cl-vote

· 21 days ago

So apparently, there's no bcrypt implementation for Common Lisp. There's an ffi wrapper which isn't in quicklisp, but that's all I could find. Which is mildly annoying, because as mentioned last time, I need to store tokens basically the same way I would store passwords. There doesn't seem to be anything similar at a cursory glance, although it's always possible I missed something.

Oh well.

According to the Wikipedia article pseudocode, it looks like the essence of the algorithm is

  • use the password as a key
  • to encrypt the plaintext "OrpheanBeholderScryDoubt" using blowfish in ECB mode
  • repeatedly some number of times (determined by the cost argument)

And the end result is a sufficiently one-way function that lets you store some string to compare with input later without actually keeping that string on file.

So.

tomb

I preface this by saying that I am not a crypto nerd. Probably don't use this in production anywhere, and definitely don't use it anywhere security is an actual concern. I'm not aware of a way to back out the initial plaintext, but you should take Schneier's advice about what to think of that.

That being said, I've got this toy project with a bcrypt-shaped hole in its :depends-on list, and I may as well try something.

;;;; src/tomb.lisp
(in-package #:tomb)

(defparameter *gen* (session-token:make-generator :token-length 16))

(defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish))
  (let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt)))
	 (initial-hash (hash-for-tomb arr cipher-name))
	 (cipher (ironclad:make-cipher cipher-name :key initial-hash  :mode :ecb))
	 (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
    (ironclad:encrypt cipher initial-hash output)
    (loop repeat (expt 2 cost)
       do (ironclad:encrypt-in-place
	   (ironclad:make-cipher cipher-name :key output :mode :ecb)
	   output))
    (format nil "$0w$~a$~a$~a$~a"
	    cipher-name
	    cost
	    salt
	    (ironclad:byte-array-to-hex-string output))))

(defun hash-for-tomb (arr cipher-name)
  (ironclad:digest-sequence
   (case cipher-name
     (:threefish512 :sha512)
     (:threefish1024 :skein1024)
     (t :sha256))
   arr))

(defun tomb-matches? (string hashed)
  (destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t)
    (declare (ignore hash))
    (assert (string= name "0w"))
    (let ((cost (parse-integer cost))
	  (cipher-name (intern cipher-name :keyword)))
      (string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed))))

Principles first.

  1. Sane defaults - We don't want to make the user1 do any more work than they have to. Which means that the minimal call to the top level interface should be something that goes String -> String rather than needing the user to generate their own salt, specify a cipher or do any type conversions.
  2. Flexible implementation - We shouldn't assume a particular salting strategy, input size, or cipher. We need to limit ourselves to ECB mode, because changing that is deep magic that I'm not getting anywhere near without a deeper understanding.
  3. Use Crypto Primitives - Speaking of deep magic, we're not writing anything ourselves from the bytes up. ironclad is a thing, and it works well if sometimes counter-intuitively, and I fully intend to take advantage.

With that out of the way, here's tomb, which is sort of like crypt.

...
(defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish))
  (let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt)))
	 (initial-hash (hash-for-tomb arr cipher-name))
	 (cipher (ironclad:make-cipher cipher-name :key initial-hash  :mode :ecb))
	 (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
    (ironclad:encrypt cipher initial-hash output)
    (loop repeat (expt 2 cost)
       do (ironclad:encrypt-in-place
	   (ironclad:make-cipher cipher-name :key output :mode :ecb)
	   output))
    (format nil "$0w$~a$~a$~a$~a"
	    cipher-name
	    cost
	    salt
	    (ironclad:byte-array-to-hex-string output))))
...

The core function is entomb. It takes a string (your password/passphrase), and optionally also salt, cost and cipher-name. If you don't pass in any of those, it chooses sane defaults, including using session-token/cl-isaac to generate a secure random salt value.

The first thing we do is concatenate the string and salt values, convert the result to an ironclad byte-array, then hash it. Hashing it using some secure digest method that produces the appropriate number of bytes to be used as a key for the chosen cipher.

...
(defun hash-for-tomb (arr cipher-name)
  (ironclad:digest-sequence
   (case cipher-name
     (:threefish512 :sha512)
     (:threefish1024 :skein1024)
     (t :sha256))
   arr))
...

It looks like sha256 is good enough for most of the ECB capable ciphers in ironclad, but threefish512 and threefish1024 need larger keys than it provides, so we use other approaches when using those ciphers. I don't want to make it too easy to use weaker ciphers, so I don't bother using hashes that result in keys smaller than sha256.

...
	 (cipher (ironclad:make-cipher cipher-name :key initial-hash  :mode :ecb))
	 (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
    (ironclad:encrypt cipher initial-hash output)
    (loop repeat (expt 2 cost)
       do (ironclad:encrypt-in-place
	   (ironclad:make-cipher cipher-name :key output :mode :ecb)
	   output))
    (format nil "$0w$~a$~a$~a$~a"
	    cipher-name
	    cost
	    salt
	    (ironclad:byte-array-to-hex-string output))))
...

Next up, we initialize an ironclad cipher with the appropriate base state, and allocate an output simple-array to stuff the results in. Then we use the initialized cipher to ironclad:encrypt our input hash (complete with salt) and put the results in output. Once that's done, we encrypt-in-place the output with the same settings, changing out the key each time. The thing we're encrypting the first time though is the key (with itself), and every subsequent layer of encryption also uses itself as the key.

Once we've done this, we stitch everything together into a string that contains documentation about its' creation.

(defun tomb-matches? (string hashed)
  (destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t)
    (declare (ignore hash))
    (assert (string= name "0w"))
    (let ((cost (parse-integer cost))
	  (cipher-name (intern cipher-name :keyword)))
      (string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed))))

tomb-matches? takes a string and an entombed string, and returns a yay or nay about whether they match. It does this by decomposing the entombed string in a way that lets it figure out what arguments to pass to entomb, and does so on the input string.

Next Step

This library is now on github in case you are like me, and want to experiment with low-security-but-principled systems. For my part, I'll probably add it to quicklisp, and definitely as a requirement to cl-vote so that I can put together a good recovery token system.

It mildly amuses me to think that knowing that token in this case is technically a "known plaintext" attack.

  1. Me.

Alexander Artemenkolazy

· 22 days ago

This is a small library by @codeninja_blog. It provides only a macro to wrap and remember any form and a function to force its evaluation.

For example, let's create a few functions which accept and return lazy objects:

POFTHEDAY> (defun request-name ()
             (lazy:lazy
               (format t "What is your name?~%")
               (read-line)))


POFTHEDAY> (defun greet (name)
             (lazy:lazy
               (format nil "Hello ~A!~%"
                       (lazy:lazy-value name))))

POFTHEDAY> (greet (request-name))
#<LAZY::THUNK UNREALIZED>

POFTHEDAY> (lazy:lazy-value *)
What is your name?
Bob
"Hello Bob!
"

;; Second attempt to get the greeting value
;; is not request for the user's name:
POFTHEDAY> (lazy:lazy-value **)
"Hello Bob!
"

Or we can build a simple lazy sequences library.

This function will create a sequence of numbers:

POFTHEDAY> (defun make-lazy-sequence (&optional (start 0) (step 1))
             (lazy:lazy
               (values start
                       (make-lazy-sequence (+ start step)
                                           step))))

This one will skip a number of items:

POFTHEDAY> (defun lazy-skip (n lazy-sequence)
             (lazy:lazy
               (loop do
                 (multiple-value-bind (item rest)
                     (lazy:lazy-value lazy-sequence)
                   (when (zerop n)
                     (return (values item rest)))
                   (decf n)
                   (setf lazy-sequence rest)))))

And this one will force lazy evaluation and transform the sequence into the list:

POFTHEDAY> (defun lazy-to-list (n lazy-sequence)
             (loop with result = nil
                   do (multiple-value-bind (item rest)
                          (lazy:lazy-value lazy-sequence)
                        (when (zerop n)
                          (return (nreverse result)))
                        (push item result)
                        (setf lazy-sequence rest)
                        (decf n))))

And of cause we need a generic map function to apply transformations:

POFTHEDAY> (defun lazy-mapcar (func sequence)
             (lazy:lazy
               (multiple-value-bind (item rest)
                   (lazy:lazy-value sequence)
                 (values (funcall func item)
                         (lazy-mapcar func rest)))))

Here is how we can apply these functions to process a lazy sequence:

POFTHEDAY> (make-lazy-sequence)

POFTHEDAY> (lazy-skip 5 *)

POFTHEDAY> (lazy-mapcar (lambda (x)
                          (format t "Multiplying ~A to ~A~%"
                                  x x)
                          (* x x))
                        *)

POFTHEDAY> (lazy-to-list 3 *)
Multiplying 5 to 5
Multiplying 6 to 6
Multiplying 7 to 7
Multiplying 8 to 8
(25 36 49)

But this will work only with my pull request which makes the lazy-value return all values, returned by original form.

Anyway, lazy is a small and very nice library. Thank you, @codeninja_blog.

Alexander Artemenkodynamic-classes

· 23 days ago

This library allows to dynamically create CLOS classes as a mixin composition. Mixins are choosen depending on parameters given to the constructor.

For example, if we have in our system users, which can be authenticated and additionally can be admins, then we can to define their classes like:

POFTHEDAY> (defclass user ()
             ())

POFTHEDAY> (defclass authenticated ()
             ((email :initarg :email)))

POFTHEDAY> (defclass admin ()
             ())

Now we need to tell the system how to apply our mixins when different parameters are passed. If there is :email, then the user will be considered authenticated. If there is :is-admin t - he is the admin.

POFTHEDAY> (dynamic-classes:add-parameter->dynamic-class
            :user :email 'authenticated)
NIL
POFTHEDAY> (dynamic-classes:add-parameter->dynamic-class
            :user :is-admin 'admin)
NIL

We also have to declare these methods to make the framework do its job. Probably this can be avoided if only the default implementation was specialized not on class-type (eql nil).

POFTHEDAY> (defmethod dynamic-classes:include-class-dependencies
               ((class-type (eql :user))
                dynamic-class class-list &rest parameters)
             "This method can modify list of classes used to combine into a new class
              for given parameters. Or some restrictions can be applied."
             (declare (ignorable dynamic-class parameters))
             class-list)

POFTHEDAY> (defmethod dynamic-classes:existing-subclass
               ((class-type (eql :user)) class-list)
             "This method allows to return a custom class. If it returns nil,
              the first class from the class-list will be choosen."
             (declare (ignorable class-list))
             (values nil))

Now let's check how it works. There is a function to create and return the class depending on the parameters:

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user)
USER

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email "some@gmail.com")
USER-AND-AUTHENTICATED

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email nil)
USER-AND-AUTHENTICATED

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :email "some@gmail.com"
                                                    :is-admin t)
USER-AND-AUTHENTICATED-AND-ADMIN

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :is-admin t)
USER-AND-ADMIN

Do you see there a strange behavior? We can pass the nil as an email and user will be considered authenticated or we can use :is-admin without email and will get unauthenticated admin class!

Fortunately, there is a hook to apply additional restrictions:

POFTHEDAY> (defmethod dynamic-classes:include-class-dependencies
               ((class-type (eql :user))
                dynamic-class class-list &rest parameters)
             (declare (ignorable dynamic-class parameters))

             ;; If email is not given we don't want consider
             ;; the user authenticated:
             (when (and (member :email parameters)
                        (null (getf parameters :email)))
               (rutils:removef class-list 'authenticated))

             ;; And if :is-admin nil then he is not an admin:
             (when (and (member :is-admin parameters)
                        (null (getf parameters :is-admin)))
               (rutils:removef class-list 'admin))

             ;; Also, we need admins always be authenticated:
             (when (and (member 'admin class-list)
                        (not (member 'authenticated class-list)))
               (error "Admin should have an email!"))

             class-list)

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :email "some@gmail.com"
                                                    :is-admin t)
USER-AND-AUTHENTICATED-AND-ADMIN

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :email "some@gmail.com"
                                                    :is-admin nil)
USER-AND-AUTHENTICATED

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :email nil
                                                    :is-admin nil)
USER

POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user
                                                    :email nil
                                                    :is-admin t)
; Debugger entered on #<SIMPLE-ERROR "Admin should have an email!" {100B6CAD73}>

Now we need to wrap this into a single constructor make-user which will return objects of different class depending on arguments:

POFTHEDAY> (defun make-user (&rest args &key email is-admin)
             (declare (ignore email is-admin))
             (let ((class (apply #'dynamic-classes:determine-dynamic-class
                                 :user 'user
                                 args)))
               (apply #'make-instance class
                      ;; We don't store is-admin as the slot:
                      (rutils:remove-from-plist args :is-admin))))

POFTHEDAY> (make-user)
#<USER {1006704893}>

POFTHEDAY> (make-user :email "blah@min.or")
#<USER-AND-AUTHENTICATED {1006779083}>

POFTHEDAY> (make-user :email "blah@min.or" :is-admin t)
#<USER-AND-AUTHENTICATED-AND-ADMIN {10067C26C3}>

POFTHEDAY> (make-user :is-admin t)
; Debugger entered on #<SIMPLE-ERROR "Admin should have an email!" {10067D0193}>

To make these classes print in a human-readable way, use print-items library, reviewed in the post #0145.

The more sophisticated use of the dynamic-classes can be found in the cl-containers library. It uses dynamic-classes to mix container and iterator classes to give them different traits depending on constructor's parameters.

Leo ZovicAuthentication Part 4.875

· 23 days ago

CLJ in Practice

I finally got around to using clj in a prototyping context. And it's going relatively smoothly so far. My only real complaint is that I seem to have to put

(named-readtables:in-readtable clj:syntax)

at the top of every file where I want to use my cool new map/set literal syntax. I'm hoping there's some way to fix this by just putting it at the top of a package file or something, but that naive solution doesn't seem to work. At first glance, there doesn't seem to be a way to express "load this project with a given, non-default readtable", and I'm not entirely sure why yet.

Return to cl-vote

The project I put some work into is an old piece of arcana from the earlier days of the Toronto CS Cabal. A simple voting system to help us decide what we're reading in a given week. The next step I'm going to take is implementing the actual voting. Step one was just the authentication system.

So here's the deal. Passwords suck, public keys aren't really being used widely for website/app authentication, and that doesn't seem to be something I can easily change. Authenticator apps and 2FA are propagating though. For low-security-requirement situtations, one plausible alternative to passwords is just using that authenticator. So, like, 1FA. The current state of cl-vote is an implementation of such a system in Common Lisp.

The workflow looks like this:

  1. You register by picking a user name that hasn't already been picked.
  2. The system instantly sends you to a screen that displays a QR code compatible with FreeOTP or Authy or whatever
  3. When you want to log in later, enter your username and your authentication code

That's fairly simple. There's no need to remember passwords, though you do now need your phone or authenticator app/browser plugin/what-have-you.

Considering Humane Interfaces

During the construction of this, I briefly considered taking the Raskin approach of letting users log in with just their "password"s. Mechanically, this would involve iterating through the entire user database in order to find if there's anyone whose next code matches the input at login. I decided against it for three reasons

  • It opens up the attack surface; instead of guessing a particular users' next code an attacker now needs to guess any valid code that collides with any existing user. Still improbably, but lets not throw caution to the wind entirely, huh?
  • Makes login more expensive; instead of getting a particular user entry and checking their code against the given one, I need to do it for each user until I find a matching one. In the extreme case, like a user database big enough to shard, this will take an extremely long time. Which segues nicely into
  • Makes login more inconsistent; if we hit the negative extreme case, it might take long enough to verify codes that the given code might have expired in the meantime, giving us false negatives. This doesn't feel like something that would happen too often, but it's not something that's trivially or implicitly soluble either.

A user name solves enough problems that I'm content burdening users with the task of picking one.

Considering Further Security

Once I combine it with some form of hammering protection, this system is resistant to the sorts of guessing attacks that plague password systems. It's still not resistant against server database breaches. Granted, this particular one is tricky to crack in that way because it's immune to injection attacks as a result of its' data storage model 1, but that's cold comfort. If you did manage to expropriate a user record, you'd gain access to that users' shared secret and could thereafter generate correct solutions for their account at will.

That's sort of the point.

One thing I could do, as a web app proprietor, is keep client fingerprints around and be a bit more cautious about logins coming from devices that a user hasn't used before. It's not entirely clear to me what to do if I detect an anomaly. I guess one thing I could do is request a challenge answer through a different contact method. Like an SMS sender or email, to which I would send a challenge generated by a session-specific secret key and then expect a response.

Doing that would also effectively mitigate the database expropriation attack. It wouldn't mitigate a successful server takeover, but I'm not sure there's a reasonable way to mitigate that at all yet. This might be good enough.

Considering Account Recovery

Account recovery codes are a thing that 2FA systems use to "make" "sure" that a user can still get into their account if they lose their phone/authenticator token/whatever. The way this works is by having the user write down a bunch of codes, each of which can presumably be used for a one-time entry into the system without other authentication methods being available. Cool, I guess. I haven't had to use them yet, and I suspect the sorts of systems I'm planning to build lend themselves more easily to the "make a new account" recovery path than this, but it might still be worth doing.

Mechanically, this means generating some number of alphanumeric codes that are either easy to write down or easy to remember. Then giving the user a workflow where they can enter one of these codes, at which point they are logged in but the code they used is marked as expired.

I'm going to try to implement a couple of these extras, then get bored and move on to the main point.

Which is collective decision making.

  1. And also the "Who would actually try to hack a Common Lisp app" thing. There are definitely lower hanging positions that bear more fruit.

Alexander Artemenkoportable-threads

· 25 days ago

This system is similar to bordeaux-threads but has some unique features.

What I like is that portable-threads forces you to give the thread a name. No more Anonumous threads!

Also, there is a shortcut macro to start any code in a thread without wrapping it into an explicit lambda:

POFTHEDAY> (portable-threads:spawn-form 
             (format t "Running in ~S thread"
                     (portable-threads:thread-name
                      (portable-threads:current-thread))))

Running in "Form (FORMAT T ...)" thread
#<SB-THREAD:THREAD "Form (FORMAT T ...)" FINISHED values: NIL {10051E61C3}>

Or there is also a shortcut to run periodical tasks in the thread:

POFTHEDAY> (defun periodic ()
             (format t "[~A] Running in ~S thread~%"
                     (local-time:now)
                     (portable-threads:thread-name
                      (portable-threads:current-thread))))

POFTHEDAY> (portable-threads:spawn-periodic-function
            #'periodic
            5
            :count 3
            :verbose t)

;; Spawning periodic-function thread for...
#<SB-THREAD:THREAD "Periodic Function" RUNNING {100466CDB3}>
[2020-08-23T14:00:35.207071+03:00] Running in "Periodic Function" thread
[2020-08-23T14:00:40.214253+03:00] Running in "Periodic Function" thread
[2020-08-23T14:00:45.215454+03:00] Running in "Periodic Function" thread
;; Exiting periodic-function thread

Another cool feature not found in bordeaux-threads is thread hibernation. Any thread can fall asleep and be awakened later:

POFTHEDAY> (defun do-the-job ()
             (format t "Started a thread ~A~%"
                     (portable-threads:thread-name
                      (portable-threads:current-thread)))
             ;; Now we'll fall asleep until somebody will
             ;; call awake.
             (portable-threads:hibernate-thread)
             (format t "Thread ~A works again!~%"
                     (portable-threads:thread-name
                      (portable-threads:current-thread))))

POFTHEDAY> (defparameter *thread*
             (portable-threads:spawn-thread "Worker"
                                            #'do-the-job))
Started a thread Worker

POFTHEDAY> (portable-threads:thread-whostate *thread*)
"Alive"

;; Now we wake thread up:

POFTHEDAY> (portable-threads:awaken-thread *thread*)
Thread Worker works again!
0

There are other interesting helpers like protected calls to work with lists.

Read the documentation to find more gems!

Alexander Artemenkosnakes

· 26 days ago

This system makes it very easy to create and use a generator in Python style.

This code demostrates how a simple generator works in Python. The generator creates an iterable object and values can be extracted by calling the next function:

In [1]: def simple():
   ...:     yield 1
   ...:     print('LOG: Going to the second yield')
   ...:     yield 2
   ...:

In [2]: simple()
Out[2]: <generator object simple at 0x10752a050>

In [3]: next(_2)
Out[3]: 1

In [4]: next(_2)
LOG: Going to the second yield
Out[4]: 2

In [5]: next(_2)
------------------
StopIteration

The similar generator can be implemented with snakes:

POFTHEDAY> (snakes:defgenerator simple ()
             (snakes:yield 1)
             (format t "LOG: Going to the second yield~%")
             (snakes:yield 2))

POFTHEDAY> (simple)
#<SNAKES:BASIC-GENERATOR {1008454D4B}>

POFTHEDAY> (funcall *)
LOG: Going to the second yield
1

POFTHEDAY> (funcall **)
2

POFTHEDAY> (funcall ***)
SNAKES:GENERATOR-STOP

Here is the more interesting example of the generator which produces an infinite sequence of Fibonacci numbers:

POFTHEDAY> (snakes:defgenerator fib ()
             (loop with a = 0
                   with b = 1
                   for new-b = (+ a b)
                   do (snakes:yield a)
                      (setf a b
                            b new-b)))

POFTHEDAY> (snakes:take 20 (fib))
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)

;; Or we can skip first 50 numbers and output 5 next:
POFTHEDAY> (snakes:generator->list
            (snakes:islice (fib)
                           50 55))
(12586269025 20365011074 32951280099 53316291173 86267571272)

There are also other features like:

  • anonymous generators;
  • yield-from form;
  • forms to iterate over generators;
  • functions ported from Python's itertools;
  • integration with iterate library.

Snakes has a comprehensive documentation which covers all its features.

Alexander Artemenkotexp

· 27 days ago

This is a little wrapper around TeX language to make it compatible with Lisp's sexps. Written by @eugeneia_.

Here is a little example, I've taken from the documentation:

POFTHEDAY> (defun tex-menu (menu)
             (texp:deftex item (caption price)
               (texp:$ caption) " " (texp:$ (texp:escape "$")) (texp:$ price)
               (texp:br)
               (texp::bigskip))
             (loop for (caption price) in menu
                   do (texp:tex (item {(texp:$ (texp:escape caption))}
                                      {(texp:$ (texp:escape price))})))
             (texp:tex (bye)))


POFTHEDAY> (tex-menu '(("Mozzarella Sticks" "5.99")
                       ("Onion Rings" "4.99")
                       ("Spinach" "5.99")))
\def \item #1#2{#1 \$#2

\bigskip }

\item {Mozzarella Sticks}{5.99}\item {Onion Rings}{4.99}\item {Spinach}{5.99}\bye

To render the DVI file, save this output into the file example.tex and run tex example.tex. (On OSX you can install TeX using brew cask install mactex.)

This command will generate example.tex file which will look like that:

With this system, you can use full power or the Lisp to write publishing systems. For example, Geneva documentation system uses it to generate TeX and LaTeX outputs.

Alexander Artemenkocl-flat-tree

· 28 days ago

This system implements an interesting algorithm suitable for storing binary tries or transmitting them over the wire without overhead on storing pointers.

There is almost no information about this algorithm on the internet. The best description I found is:

https://datprotocol.github.io/book/ch01-01-flat-tree.html

Also, there are versions for Go, C, JS, Rust and Kotlin listed here:

https://github.com/mafintosh/flat-tree

Let's try to serialize a binary tree, represented by lists into a flat vector. First, we need to prepare a vector which size depends on the depth of the tree:

;; Here is a tree:
;;            /
;;       *
;;   +     15   100.0
;; A   B

POFTHEDAY> (defparameter *structure*
             '(/ (* (+ a b)
                    15)
                 100.0))

POFTHEDAY> (defparameter *depth*
             (rutils:tree-depth *structure*))

POFTHEDAY> *depth*
4

POFTHEDAY> (defparameter *size* (expt 2 *depth*))

POFTHEDAY> (defparameter *data*
             (make-array (list (expt 2 *depth*))
                         :initial-element nil))
#(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)

Missing nodes are filled with nils.

Flat-tree is not a data-structure; it is an algorithm to calculate the tree node's index in the flat vector.

That is why we need to write a function which will take lists forming a binary tree and dump it into the vector as a "flat-tree":

POFTHEDAY> (defun fill-tree (vector obj depth offset)
             (let ((index (flat-tree:index depth offset)))
               (cond
                 ((listp obj)
                  (setf (aref vector index)
                        (first obj))
                  (fill-tree vector (second obj)
                             (1- depth) 0)
                  (fill-tree vector (third obj)
                             (1- depth) 1))
                 ;; If it is a symbol
                 (t
                  (setf (aref vector index)
                        obj))))
             (values vector
                     obj))

POFTHEDAY> (fill-tree *data* *structure* 3 0)

;; The first value is a resulting vector
#(A + B * NIL 15 NIL / NIL NIL NIL 100.0 NIL NIL NIL NIL)

;; And the second is original data-structure
(/ (* (+ A B) 15) 100.0)

We also can define a function to print our tree in a readable form.

If you are more skilled in ASCII Art than me, maybe you can provide a more advanced version?

POFTHEDAY> (defun print-flat-tree (vector)
             (loop for item across vector
                   for index upfrom 0
                   for as-str = (format nil "~S" item)
                   for depth = (flat-tree:depth index)
                   for padded = (str:pad-left (* depth 5) as-str)
                   when item
                     do (format t "~A~%"
                                padded)))

POFTHEDAY> (print-flat-tree *data*)
A
    +
B
         *
   15
              /
     100.0

As a home task, I'll leave a function which restores the lisp data-structure from the vector. The solution should work with sparse tries like this one:

POFTHEDAY> read-flat-tree(#(A + B * NIL 15 NIL / NIL NIL NIL 100.0 NIL NIL NIL NIL))

(/ (* (+ A B)
      15)
   100.0)

Hope to see you tomorrow in the next #poftheday post!

Michał HerdaWhen CL:TENTH is not enough

· 28 days ago

#Lisp #CommonLisp

            ;;;; License: don't use this at home

(defmacro defnth (n)
  (let ((var (gensym "LIST"))
        (name (intern (substitute #\- #\Space (format nil "~:@(~:R~)" n)))))
    `(defun ,name (,var) (nth (1- ,n) ,var))))

CL-USER> (defnth 1234)
ONE-THOUSAND-TWO-HUNDRED-THIRTY-FOURTH

CL-USER> (one-thousand-two-hundred-thirty-fourth (loop for i from 1 below 2000 collect i))
1234

          

Alexander Artemenkobreeze

· 29 days ago

This project is still in the development phase but I like its idea. Breeze tries to improve the development process. Especially interesting feature - it's ability to run tests on function redefinition!

To make it work, you have to use defun and deftest from the breeze:

POFTHEDAY> (breeze:defun foo ()
             100)

;; When we define the test, it is immediately
;; runned in a separate thread:
POFTHEDAY> (breeze:deftest test-foo
             (unless (= (foo) 42)
               (error "Foo should return 42")))
Running all tests...
WARNING: 
Test TEST-FOO failed with condition Foo should return 42

Test "TEST-FOO" failed with condition:
"Foo should return 42"
Done [0/1] tests passed.

;; Now I'm going to fix it.
;; Pay attention on output. Breeze automatically
;; runs tests for 'foo function in a separate thread:
POFTHEDAY> (breeze:defun foo ()
             42)
Running all tests....
Done [1/1] tests passed.

;; Now let's break it again!
POFTHEDAY> (breeze:defun foo ()
             77)
FOO
Running all tests...
WARNING: 
Test TEST-FOO failed with condition Foo should return 42

Test "TEST-FOO" failed with condition:
"Foo should return 42"
Done [0/1] tests passed.

There is also some extension for Emacs and SLIME, but I didn't test it yet. I hope the author will make this system more usable.

The first feature which comes in mind is support for existing unit-testing frameworks. The second is an indicator for Emacs mode-line if some tests failed after I hit C-c C-c.

To conclude, make good tooling! Tooling should be convenient!

Alexander Artemenkolyrics

· 30 days ago

Today we'll have some fun because this library allows us to search for music text and sing together!

Install the library and do this in the REPL:

POFTHEDAY> (lyrics:lyrics "Bob Kanefsky" "eternal flame")
"I was taught Assembler in my second year of school.
It's kinda like construction work --
with a toothpick for a tool.
So when I made my senior year,
I threw my code away,
And learned the way to program
that I still prefer today.

Now, some folks on the Internet
put their faith in C++.
They swear that it's so powerful,
it's what God used for us.
And maybe He lets mortals dredge
their objects from the C.
But I think that explains
why only God can make a tree.

For God wrote in Lisp code
When he filled the leaves with green.
The fractal flowers and recursive roots:
The most lovely hack I've seen.
And when I ponder snowflakes,
never finding two the same,
I know God likes a language
with its own four-letter name.

Now, I've used a SUN under Unix,
so I've seen what C can hold.
I've surfed for Perls, found what Fortran's for,
Got that Java stuff down cold.
Though the chance that I'd write COBOL code
is a SNOBOL's chance in Hell.
And I basically hate hieroglyphs,
so I won't use APL.

Now, God must know all these languages,
and a few I haven't named.
But the Lord made sure, when each sparrow falls,
that its flesh will be reclaimed.
And the Lord could not count grains of sand
with a 32-bit word.
Who knows where we would go to
if Lisp weren't what he preferred?

And God wrote in Lisp code
Every creature great and small.
Don't search the disk drive for man.c,
When the listing's on the wall.
And when I watch the lightning burn
Unbelievers to a crisp,
I know God had six days to work,
So he wrote it all in Lisp.

Yes, God had a deadline.
So he wrote it all in Lisp."

It is also can grep all texts you've ever found. For example, we can find all lines which mention the LISP:

POFTHEDAY> (lyrics:search-song "lisp")
(("Bob Kanefsky" "eternal flame" "For God wrote in Lisp code")
 ("Bob Kanefsky" "eternal flame" "if Lisp weren't what he preferred?")
 ("Bob Kanefsky" "eternal flame" "And God wrote in Lisp code")
 ("Bob Kanefsky" "eternal flame" "So he wrote it all in Lisp."))

Ok, enough coding, let's sing together! If you don't know the tune, open this video:

https://www.youtube.com/watch?v=u-7qFAuFGao

Or open these chords for the guitar:

https://gist.github.com/jimweirich/6181853

Alexander Artemenkosimple-tasks

· 31 days ago

This is a @Shinmera's library for task processing. It implements abstraction over multithreading/multiprocessing which operates by means of a runner and a task.

A runner in the simple-task is an object responsible for task scheduling. By default, only a simple queued-runner is implemented. It executes all task in a single thread one by one.

simple-task has good documentation but there is no big example showing the essence of the runner/task concept. Let's fix it!

Next example creates a single thread for the runner and starts separate threads where each thread executes a task in a different way.

First, we need to start the runner:

POFTHEDAY> (defvar *thread*
             (simple-tasks:make-runner-thread *runner*))

;; It is the third in this list:

POFTHEDAY> (bt:all-threads)
(#<SB-THREAD:THREAD "sly-channel-1-mrepl-remote-1" RUNNING {10037F5B93}>
 #<SB-THREAD:THREAD "reader-thread" RUNNING {10026F8103}>
 #<SB-THREAD:THREAD "runner thread" waiting on:
      #<WAITQUEUE task-runner-condition {1003231D63}>
    {100323F833}>
 #<SB-THREAD:THREAD "slynk-indentation-cache-thread" waiting on:
      #<WAITQUEUE  {1002700143}>
    {10026F8233}>
 #<SB-THREAD:THREAD "main thread" RUNNING {1001538543}>
 #<SB-THREAD:THREAD "Slynk Sentinel" waiting on:
      #<WAITQUEUE  {10025300B3}>
    {1002529253}>
 #<SB-THREAD:THREAD "control-thread" waiting on:
      #<WAITQUEUE  {10026F8343}>
    {10026F5D73}>)

Next, we'll start our tasks. Each of them will print the current thread. This way we'll ensure all of them are running in the runner's thread:

POFTHEDAY> (defun print-and-return-current-thread ()
             (let ((name (bt:thread-name (bt:current-thread))))
               (format t "Running in \"~A\" thread.~%"
                       name)
               (values name)))

POFTHEDAY> (defvar *first-task*
             (make-instance
              'simple-tasks:call-task
              :func #'print-and-return-current-thread))

POFTHEDAY> (simple-tasks:status *first-task*)
:CREATED

POFTHEDAY> (simple-tasks:schedule-task *first-task*
                                       *runner*)
Running in "runner thread" thread.

POFTHEDAY> (simple-tasks:status *first-task*)
:COMPLETED

POFTHEDAY> (simple-tasks:return-values *first-task*)
"runner thread"

POFTHEDAY> (defvar *second-task*
             (make-instance
              'simple-tasks:blocking-call-task
              :func #'print-and-return-current-thread))

POFTHEDAY> (simple-tasks:schedule-task *second-task*
                                       *runner*)
Running in "runner thread" thread.

POFTHEDAY> (simple-tasks:return-values *second-task*)
"runner thread"

There are also a few shortcuts:

POFTHEDAY> (simple-tasks:call-as-task #'print-and-return-current-thread
                                      *runner*)
Running in "runner thread" thread.
"runner thread"

;; Or

POFTHEDAY> (simple-tasks:with-body-as-task (*runner*)
             (print-and-return-current-thread))
Running in "runner thread" thread.
"runner thread"

This library can be useful when you are working with some subsystems or external libraries which should be accessed only from the single thread.

For example, RCL (CL interface to the R language) library uses it to interop with R language.

If you are interested in other solutions for multithreading and multiprocessing, look at #poftheday posts grouped by corresponding tags:


For older items, see the Planet Lisp Archives.


Last updated: 2020-09-17 19:47