Eitaro Fukamachi fukamachi

## Dockerfile
# syntax=docker/dockerfile:experimental
ARG SBCL_VERSION=2.1.8
ARG QLOT_VERSION=0.11.4
FROM fukamachi/qlot:${QLOT_VERSION}

WORKDIR /app

COPY qlfile /app
COPY qlfile.lock /app

## seminar2019.md

      
              1 file
            
          
              0 forks
            
          
                0 comments
              
            
              3 stars
            
          
                fukamachi
                / seminar2019.md
            
            
              Last active
              October 7, 2023 15:02
            
              
                Common Lisp Seminar 2019 ログ by fukamachi
              
          
    Common Lisp Seminar 2019

2019/08/24
本町オープンソースラボ（大阪府大阪市中央区瓦町3-4-9）
https://tcool.connpass.com/event/117789/
@fukamachi が聴いた質問をまとめました。
Q. 自分のプロジェクトを .roswell/local-projects 置くのは一般的なのか？


## hoge.asd
(defsystem "hoge"
  :class :package-inferred-system
  :pathname "src"
  :depends-on ("hoge/main")
  :in-order-to ((test-op (test-op "hoge/tests"))))

(defsystem "hoge/tests"
  :pathname "tests"
  :depends-on ("hoge")
  :components

## upload-test.lisp
(ql:quickload '(:clack :http-body))

(defvar *handler*)

(setf *handler*
      (clack:clackup (lambda (env)
                       (if (eq (getf env :request-method) :get)
                           '(200 (:content-type :text-html)
                             ("<html><head></head><body><form method='post' enctype='multipart/form-data'><input type='file' name='upload'><input type='submit' value='Upload'></form></body></html>"))
                           `(200 () (,(prin1-to-string (http-body:parse (getf env :content-type) (getf env :content-length) (getf env :raw-body)))))))

## keys.lisp
(in-package :cl-user)

(ql:quickload '(:ironclad :asn1))

(defun generate-rsa-key-pair (num-bits)
  "Same as (ironclad:generate-key-pair :rsa :num-bits num-bits) except returning in DER format."
  (check-type num-bits integer)
  (let ((l (floor num-bits 2)))
    (multiple-value-bind (p q n)
        (loop for a = (ironclad:generate-prime (- num-bits l))

## fntype-annot.lisp
(annot:defannotation fntype (args result form)
    (:arity 3)
  (let* ((last-form (cl-annot.util:progn-form-last form))
         (symbol (cl-annot.util:definition-form-symbol last-form)))
    `(progn (declaim (ftype (function ,args ,result) ,symbol))
            ,form)))

;; Usage:
;;    (ql:quickload :cl-syntax)
;;    (syntax:use-syntax :annot)

## lock-pool
(defpackage #:lock-pool
  (:use #:cl)
  (:import-from #:bordeaux-threads)
  (:import-from #:alexandria
                #:once-only)
  (:export #:lock-pool
           #:make-lock-pool
           #:acquire-lock-in-pool
           #:release-lock-in-pool
           #:with-lock-pool-held))

## pkcs12-experiment.lisp
(ql:quickload '(:cl+ssl :fast-io))

(in-package #:cl-user)
(defpackage #:pkcs12-experiment
  (:use #:cl)
  (:import-from #:cffi)
  (:import-from #:cl+ssl))
(in-package #:pkcs12-experiment)

(cffi:defcfun ("EVP_PKEY_new" evp-pkey-new) :pointer)

## external-program.lisp
#+sbcl
(defun start (commands)
  (check-type commands cons)
  (multiple-value-bind (inputfd-shell outputfd-shell)
      #+win32 (sb-win32::make-named-pipe) #-win32 (sb-posix:pipe)
    (multiple-value-bind (inputfd-cl outputfd-cl)
        #+win32 (sb-win32::make-named-pipe) #-win32 (sb-posix:pipe)
      #+win32
      (setf (sb-win32::inheritable-handle-p inputfd-cl) t
            (sb-win32::inheritable-handle-p outputfd-cl) t)

## clssl.ros
#!/bin/sh
#|-*- mode:lisp -*-|#
#| Experimentation for loading CL+SSL on Windows with a custom ssleay32.dll
exec ros -Q -- $0 "$@"
|#

#|
NOTE: Put ssleay32.dll at the same directory as this script.
|#
	# syntax=docker/dockerfile:experimental
	ARG SBCL_VERSION=2.1.8
	ARG QLOT_VERSION=0.11.4
	FROM fukamachi/qlot:${QLOT_VERSION}

	WORKDIR /app

	COPY qlfile /app
	COPY qlfile.lock /app
	(defsystem "hoge"
	:class :package-inferred-system
	:pathname "src"
	:depends-on ("hoge/main")
	:in-order-to ((test-op (test-op "hoge/tests"))))

	(defsystem "hoge/tests"
	:pathname "tests"
	:depends-on ("hoge")
	:components
	(ql:quickload '(:clack :http-body))

	(defvar handler)

	(setf handler
	(clack:clackup (lambda (env)
	(if (eq (getf env :request-method) :get)
	'(200 (:content-type :text-html)
	("<html><head></head><body><form method='post' enctype='multipart/form-data'><input type='file' name='upload'><input type='submit' value='Upload'></form></body></html>"))
	`(200 () (,(prin1-to-string (http-body:parse (getf env :content-type) (getf env :content-length) (getf env :raw-body)))))))
	(in-package :cl-user)

	(ql:quickload '(:ironclad :asn1))

	(defun generate-rsa-key-pair (num-bits)
	"Same as (ironclad:generate-key-pair :rsa :num-bits num-bits) except returning in DER format."
	(check-type num-bits integer)
	(let ((l (floor num-bits 2)))
	(multiple-value-bind (p q n)
	(loop for a = (ironclad:generate-prime (- num-bits l))
	(annot:defannotation fntype (args result form)
	(:arity 3)
	(let* ((last-form (cl-annot.util:progn-form-last form))
	(symbol (cl-annot.util:definition-form-symbol last-form)))
	`(progn (declaim (ftype (function ,args ,result) ,symbol))
	,form)))

	;; Usage:
	;; (ql:quickload :cl-syntax)
	;; (syntax:use-syntax :annot)
	(defpackage #:lock-pool
	(:use #:cl)
	(:import-from #:bordeaux-threads)
	(:import-from #:alexandria
	#:once-only)
	(:export #:lock-pool
	#:make-lock-pool
	#:acquire-lock-in-pool
	#:release-lock-in-pool
	#:with-lock-pool-held))
	(ql:quickload '(:cl+ssl :fast-io))

	(in-package #:cl-user)
	(defpackage #:pkcs12-experiment
	(:use #:cl)
	(:import-from #:cffi)
	(:import-from #:cl+ssl))
	(in-package #:pkcs12-experiment)

	(cffi:defcfun ("EVP_PKEY_new" evp-pkey-new) :pointer)
	#+sbcl
	(defun start (commands)
	(check-type commands cons)
	(multiple-value-bind (inputfd-shell outputfd-shell)
	#+win32 (sb-win32::make-named-pipe) #-win32 (sb-posix:pipe)
	(multiple-value-bind (inputfd-cl outputfd-cl)
	#+win32 (sb-win32::make-named-pipe) #-win32 (sb-posix:pipe)
	#+win32
	(setf (sb-win32::inheritable-handle-p inputfd-cl) t
	(sb-win32::inheritable-handle-p outputfd-cl) t)
	#!/bin/sh
	#\|-- mode:lisp --\|#
	#\| Experimentation for loading CL+SSL on Windows with a custom ssleay32.dll
	exec ros -Q -- $0 "$@"
	\|#

	#\|
	NOTE: Put ssleay32.dll at the same directory as this script.
	\|#