2016-03-12

Aserve でURLリダイレクト

Common Lisp

How to do redirects using AllegroServe
http://franz.com/support/tutorials/aserve-redirect-tutorial.htm

(publish :path "/new"
	 :content-type "text/html"
	 :function 
	 #'(lambda (req ent)
	     (with-http-response (req ent :response *response-found*)
	       (setf (reply-header-slot-value req :location)
		     (format nil "http://www.yahoo.co.jp/"))
	       (with-http-body (req ent)
		 ;; empty body. must be called as this is what
		 ;; actually pushes response out to client.
		 ))))

2016-04-03

FreeBSDの仮想化(仮想イメージの作成)

FreeBSDは全然詳しくないのですが、物理サーバで稼働するFreeBSD 7系を
KVM等に仮想化したかったためいろいろ調べました。
まず、普通にインストールメディアを使って仮想サーバにFreeBSDを
インストールしてから新規にディスクを追加し、追加したディスクに
ブートローダーの書き込みやファイルシステムを作成して
ファイルコピーをして仮想化を行います。

1. 新しいディスクの初期化（ブートローダーの書き込み）

# dd if=/dev/zero of=/dev/ad1 bs=1k count=1
# fdisk -BI /dev/ad1

2. ディスクにラベルを付ける

# disklabel -B -w -r ad1s1 auto

3. 作成したディスクラベルを編集し、パーティションを追加する

#disklabel -e ad1s1

# /dev/ad1s1:
8 partitions:
# size offset fstype [fsize bsize bps/cpg]
a: 1048576 0 4.2BSD 2048 16384 8
b: 2029200 1048576 swap
c: 33554241 0 unused 0 0 # "raw" part, don't edit
d: 3110912 3077776 4.2BSD 2048 16384 28552
e: 1048576 6188688 4.2BSD 2048 16384 8
f: 26316977 7237264 4.2BSD 2048 16384 28552

4. /etc/fstab に適切なエントリを追加する

# vi /etc/fstab

# Device Mountpoint FStype Options Dump Pass#
/dev/ad0s1b none swap sw 0 0
/dev/ad0s1a / ufs rw 1 1
/dev/ad0s1e /tmp ufs rw 2 2
/dev/ad0s1f /usr ufs rw 2 2
/dev/ad0s1d /var ufs rw 2 2
/dev/acd0 /cdrom cd9660 ro,noauto 0 0

5. 作成したすべてのパーティションに対してこれを繰り返す

# newfs /dev/ad1s1a
# newfs /dev/ad1s1e
# newfs /dev/ad1s1f
# newfs /dev/ad1s1d

6. パーティションをマウントする

# mkdir -p /mnt/a
# mkdir -p /mnt/e
# mkdir -p /mnt/f
# mkdir -p /mnt/d

# mount /dev/ad1s1a /mnt/a
# mount /dev/ad1s1e /mnt/e
# mount /dev/ad1s1f /mnt/f
# mount /dev/ad1s1d /mnt/d

7. swapの作成

# dd if=/dev/zero of=/dev/ad1s1b bs=1m

8. ファイルのコピー

# cp -a /.cshrc /mnt/a/
# cp -a /.profile /mnt/a/
# cp -a /COPYRIGHT /mnt/a/
# cp -a /bin /mnt/a/
# cp -a /boot /mnt/a/
# cp -a /cdrom /mnt/a/
# cp -a /compat /mnt/a/
# cp -a /dev /mnt/a/
# cp -a /dist /mnt/a/
# cp -a /entropy /mnt/a/
# cp -a /etc /mnt/a/
# cp -a /home /mnt/a/
# cp -a /lib /mnt/a/
# cp -a /libexec /mnt/a/
# cp -a /media /mnt/a/
# cp -a /proc /mnt/a/
# cp -a /root /mnt/a/
# cp -a /sbin /mnt/a/
# cp -a /sys /mnt/a/

# mkdir /mnt/a/mnt
# mkdir /mnt/a/rescue
# mkdir /mnt/a/tmp
# chmod 777 /mnt/a/tmp
# mkdir /mnt/a/usr
# mkdir /mnt/a/var

# cp -a /var/* /mnt/d/
# cp -a /usr/* /mnt/f/

9. パーティションのアンマウント

# umount /mnt/a
# umount /mnt/e
# umount /mnt/f
# umount /mnt/d

2016-03-12

AserveにMIMEタイプを追加する

Common Lisp

SVG(Scalable Vector Graphics)のMIMEタイプを追加するためAserveの以下のファイルを編集。

dists/quicklisp/software/portableaserve-20150923-git/aserve/publish.cl

("image/svg+xml" "svg") ("image/svg+xml" "svgz")

2016-03-06

Aserveでフォームから入力データを受け取る

Common Lisp

SBCL & Aserve でHTMLフォームよりデータを受け取る処理です。

HTMLフォーム

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<title>テスト</title>
</head>
<body>
<form action="/app/form.html" method="post">
<h3>フォームテスト</h3><br>
名前<br>
<input type="text" name="name" size="40"><br><br>
性別<br>
<input type="radio" name="sex" value="male">男
<input type="radio" name="sex" value="female">女<br><br>
血液型：<select name="blood">
<option value="A">A型</option>
<option value="B">B型</option>
<option value="O">O型</option>
<option value="AB">AB型</option>
</select><br><br>
<input type="submit" value="送信">
</form>
</body>
</html>

フォームのデータを受け取る処理

(use-package :net.aserve)
(use-package :net.html.generator)

(publish
 :path "/app/form.html"
 :content-type "text/html"
 :function
 #'(lambda (req ent)
     (let* ((name (cdr (assoc "name" (request-query req)
			       :test #'equal)))
	    (sex (cdr (assoc "sex" (request-query req)
			      :test #'equal)))
	    (blood (cdr (assoc "blood" (request-query req)
			      :test #'equal))))
       (with-http-response
	(req ent)
	(with-http-body
	 (req ent)
	 (html
	  (:html
	   (:head (:title "test"))
	   (:body 
	    (:princ-safe name)
	     :br (:princ-safe sex)
	     :br (:princ-safe blood)))))))))

2016-02-22

CLSQLでMySQLを使う

Common Lisp

1. MySQLのユーザとDBの作成

# mysql
mysql> GRANT ALL PRIVILEGES ON *.* TO testuser@localhost IDENTIFIED BY 'password' WITH GRANT OPTION;
mysql> FLUSH PRIVILEGES;

mysql> CREATE DATABASE testdb CHARACTER SET utf8;

# mysql -p -u testuser testdb

※接続が正常にできることを確認

2. 必要なパッケージをインストールする

CLSQLで実際にDBに接続するときにコンパイルがされますが、gcc等がインストールされていないとエラーになる。

# yum install gcc autoconf automake
# yum install mysql-devel

※環境はCentOS6.7です。

3. CLSQLをインストールする

(ql:quickload :clsql)

4. DBに接続

(require :clsql)
(clsql:connect '("localhost" "testdb" "testuser" "password") :database-type :mysql)

5. DBの接続状態の確認

(clsql:connected-databases)

6. データモデルを定義

(clsql:def-view-class test_tbl ()
  ((id
     :db-kind :key
     :db-constraints :not-null
     :type string
     :initarg :id)
   (data1
     :type string
     :initarg :data1)
   (data2
     :type string
     :initarg :data2)
   (data3
     :type string
     :initarg :data3))
  (:base-table test_tbl))

7. テーブルの作成と削除
テーブル作成

(clsql:create-view-from-class 'test_tbl)

テーブル削除

(clsql:drop-view-from-class 'test_tbl)

8. テーブルの参照

(clsql:query "select * from TEST_TBL" :field-names nil)

※テーブル名は大文字小文字が厳密に区別されるので注意が必要

9. レコードの登録

(clsql:insert-records :into 'test_tbl
  :attributes '(id data1 data2 data3)
  :values '("001" "データ１" "データ２" "データ３"))

10. レコードの更新

(clsql:update-records [test_tbl]
  :av-pairs'((data1 "更新データ１"))
  :where [:= [id] "001"])

11. レコードの削除

(clsql:delete-records :from [test_tbl] :where [= [id] "001"])

12. トランザクション
 ロールバック

(clsql:start-transaction)
(clsql:delete-records :from [test_tbl] :where [= [id] "001"])
(clsql:rollback)

コミット

(clsql:start-transaction)
(clsql:delete-records :from [test_tbl] :where [= [id] "001"])
(clsql:commit)

13. DB切断

(clsql:disconnect)

2016-02-21

CLSQLでPostgreSQLを使う

Common Lisp

1. PostgreSQLのユーザとDBの作成

# su - postgres
$ createuser -P testuser
$ createdb -O testuser testdb
$ psql -h localhost -U testuser testdb

※接続が正常にできることを確認

2. ライブラリのシンボリックリンク作成

CLSQLで実際にDBに接続するときにlibpq.soがロードできないとエラーが出たのでシンボリックリンクを作成しておく。

# cd /usr/lib
# ln -s libpq.so.5.2 libpq.so

※環境はCentOS6.7です。

3. CLSQLをインストールする

(ql:quickload :clsql)

4. DBに接続

(require :clsql)
(clsql:connect '("localhost" "testdb" "testuser" "password") :database-type :postgresql)

5. DBの接続状態の確認

(clsql:connected-databases)

6. データモデルを定義

(clsql:def-view-class test_tbl ()
  ((key
     :db-kind :key
     :db-constraints :not-null
     :type string
     :initarg :key)
   (data1
     :type string
     :initarg :data1)
   (data2
     :type string
     :initarg :data2)
   (data3
     :type string
     :initarg :data3))
  (:base-table test_tbl))

7. テーブルの作成と削除

テーブル作成

(clsql:create-view-from-class 'test_tbl)

テーブル削除

(clsql:drop-view-from-class 'test_tbl)

8. テーブルの参照

(clsql:query "select * from test_tbl" :field-names nil)

9. レコードの登録

(clsql:insert-records :into 'test_tbl
  :attributes '(key data1 data2 data3)
  :values '("001" "データ１" "データ２" "データ３"))

10. レコードの更新

(clsql:update-records [test_tbl]
  :av-pairs'((data1 "更新データ１"))
  :where [:= [key] "001"])

11. レコードの削除

(clsql:delete-records :from [test_tbl] :where [= [key] "001"])

12. トランザクション

ロールバック

(clsql:start-transaction)
(clsql:delete-records :from [test_tbl] :where [= [key] "001"])
(clsql:rollback)

コミット

(clsql:start-transaction)
(clsql:delete-records :from [test_tbl] :where [= [key] "001"])
(clsql:commit)

13. DB切断

(clsql:disconnect)

2016-02-20

Aserveを常駐プロセス（デーモン）にする

Common Lisp

main.lispを編集

(ql:quickload "aserve")
(ql:quickload :swank)

(defpackage cl-web
  (:use :cl
        :swank
        :net.aserve))

(in-package :cl-web)

(require :aserve)
(NET.aserve:start :port 5000)

(swank:create-server :port 4005 :style :spawn :dont-close t)

(loop (sleep 3600))

以下のコマンドで起動
nohup sbcl --load ~/lisp/main.lisp > /dev/null &

あとはSwankでホットデプロイしていくといった感じです。