Browse code

Inital

Jaidyn Lev authored on 2018-04-28 19:47:54
Showing 12 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,11 @@
1
+A Clisp library for writing CGI programs.
2
+
3
+It helps with CGI environment variables, and parses POST, GET, & cookie data
4
+into Clisp-friendly hash-tables. :-)
5
+
6
+Pre-requisites: uiop, quri, cl-ppcre, html-entities, and, of course, Quicklisp!
7
+
8
+To install, place in the ~/.local/share/common-lisp/source directory of your
9
+web-server's user, then load with `ql:quickload "cgi"` when writing programs.
10
+
11
+You can find a fully-functional example in "web/"!
0 12
new file mode 100644
... ...
@@ -0,0 +1,12 @@
1
+(defsystem "cgi"
2
+  :version "0.1"
3
+  :author "Jaidyn Lev <jadedctrl@teknik.io>"
4
+  :license "GPLv3+"
5
+  :depends-on ("uiop" "quri" "cl-ppcre" "html-entities")
6
+  :components ((:module "src"
7
+                :components
8
+		((:file "package")
9
+		(:file "misc")
10
+		(:file "main"))))
11
+  :description
12
+	"A basic CGI library for Lisp.")
0 13
new file mode 100644
1 14
Binary files /dev/null and b/src/.main.lisp.swp differ
2 15
new file mode 100644
... ...
@@ -0,0 +1,70 @@
1
+(in-package :cgi)
2
+
3
+
4
+(defun request-process (post)
5
+  "Turns GET or POST data into a hash-table of variables & corresponding values."
6
+
7
+	(let ((post-list (list-split (string-to-list post) #\&))
8
+		(post-data (make-hash-table :test `equal)))
9
+	(loop
10
+		:for x
11
+		:in post-list
12
+		:do
13
+		(let ((current-list (list-split (car post-list) #\=)))
14
+			(setf (gethash (string-sanitize (list-to-string (car current-list)))
15
+				post-data)
16
+				(string-sanitize (list-to-string (car (cdr current-list)))))
17
+			(setq post-list (cdr post-list))))
18
+	post-data))
19
+
20
+
21
+(defun cookie-create (name value &optional (path "/") (expiration nil))
22
+  "Creates a 'Set-Cookie' HTTP header string. Effectively, it creates a
23
+cookie from specified values when used in the HTTP header."
24
+
25
+	(format nil "Set-Cookie: ~A=~A; Path=~A;~A"
26
+		name
27
+		value
28
+		path
29
+		(if expiration
30
+			(format nil " Expires=~A" expiration)
31
+			"~%")))
32
+
33
+
34
+(defun populate-environment (&optional (post-data nil))
35
+  "Sets all of the CGI env-vars as global variables.
36
+I.E., cgi:*document-root* and cgi:*query-string*.
37
+Also sets cgi:*post*, cgi:*get*, and cgi:*cookie* as hash-tables containing
38
+sets of variables and their respective values-- this is useful for fetching
39
+a specific variable-- like the value of 'id' from the GET query '?id=20'."
40
+
41
+	(setq *document-root* (uiop/os:getenv "DOCUMENT_ROOT"))
42
+	(setq *http-cookie* (uiop/os:getenv "HTTP_COOKIE"))
43
+	(setq *http-host* (uiop/os:getenv "HTTP_HOST"))
44
+	(setq *http-referer* (uiop/os:getenv "HTTP_REFERER"))
45
+	(setq *http-user-agent* (uiop/os:getenv "HTTP_USER_AGENT"))
46
+	(setq *https* (uiop/os:getenv "HTTPS"))
47
+	(setq *path* (uiop/os:getenv "PATH"))
48
+	(setq *query-string* (uiop/os:getenv "QUERY_STRING"))
49
+	(setq *remote-addr* (uiop/os:getenv "REMOTE_ADDR"))
50
+	(setq *remote-host* (uiop/os:getenv "REMOTE_HOST"))
51
+	(setq *remote-port* (uiop/os:getenv "REMOTE_PORT"))
52
+	(setq *remote-user* (uiop/os:getenv "REMOTE_USER"))
53
+	(setq *request-method* (uiop/os:getenv "REQUEST_METHOD"))
54
+	(setq *request-uri* (uiop/os:getenv "REQUEST_URI"))
55
+	(setq *script-filename* (uiop/os:getenv "SCRIPT_FILENAME"))
56
+	(setq *script-name* (uiop/os:getenv "SCRIPT_NAME"))
57
+	(setq *server-admin* (uiop/os:getenv "SERVER_ADMIN"))
58
+	(setq *server-name* (uiop/os:getenv "SERVER_NAME"))
59
+	(setq *server-port* (uiop/os:getenv "SERVER_PORT"))
60
+	(setq *server-software* (uiop/os:getenv "SERVER_SOFTWARE"))
61
+
62
+	(if *query-string*
63
+		(setq *get* (request-process *query-string*))
64
+		(setq *get* nil))
65
+	(if post-data
66
+		(setq *post* (request-process post-data))
67
+		(setq *post* nil))
68
+	(if *http-cookie*
69
+		(setq *cookie* (request-process *http-cookie*))
70
+		(setq *cookie* nil)))
0 71
new file mode 100644
... ...
@@ -0,0 +1,80 @@
1
+(in-package :cgi)
2
+
3
+
4
+(defun positions (needle operated-list)
5
+   "Returns all positions of a set 'needle' in a list."
6
+        (let ((list operated-list)
7
+                (positions ()))
8
+
9
+        (loop
10
+                :while (find needle list :test #'equal)
11
+                :do
12
+                        (setq positions (append (list (position needle list :test #'equal)) positions))
13
+                        (setf (nth (position needle list :test #'equal) list) nil))
14
+        positions))
15
+
16
+
17
+(defun string-to-list (string)
18
+  "Converts string to a list of characters."
19
+	(let ((charlist `()))
20
+	(loop
21
+		:for x
22
+		:from 0
23
+		:to (- (length string) 1)
24
+		:do (setq charlist (append charlist (list (char string x)))))
25
+	charlist))
26
+
27
+
28
+(defun strz (&rest args)
29
+   "Converts string to string surrounded by escaped quotation marks."
30
+	(format nil "\"~A\"" (car args)))
31
+
32
+
33
+(defun list-to-string (list)
34
+   "Converts a list of characters to a string."
35
+	(reduce `string-concat
36
+		(mapcar `string list)))
37
+
38
+
39
+(defun list-split (list split)
40
+   "Splits a list into sub-lists based on a set element. I.E.,
41
+  'split at instances of 2 in `(1 2 3 4 2 5 6 7)'"
42
+	(let ((current-list `())
43
+		(overarching-resultant-list `())
44
+		(overarching-list list))
45
+	(loop
46
+		:for x
47
+		:in list
48
+		:do
49
+		(if (equal split x)
50
+			(setq overarching-resultant-list (append overarching-resultant-list (list current-list)))
51
+			(setq current-list (append current-list (list x))))
52
+		(if (equal split x)
53
+			(setq current-list `()))
54
+		(if (eq (length overarching-list) 1)
55
+			(setq overarching-resultant-list (append overarching-resultant-list (list current-list))))
56
+		(setq overarching-list (cdr overarching-list)))
57
+	overarching-resultant-list))
58
+
59
+
60
+(defun string-concat (&rest strs)
61
+   "Concatenates strings."
62
+	(apply `concatenate `string strs))
63
+
64
+(defun string-sanitize (str)
65
+  "Sanitizes input strings from POST or GET requests.
66
+   Ex:
67
+   *  %3F → ?
68
+   *  %26%239773%3B → ☭"
69
+	(quri:url-decode str))
70
+
71
+
72
+(defun char-code (str)
73
+  "Returns a character from its code."
74
+        (let ((chars (string-to-list str)))
75
+        (character
76
+                (parse-integer
77
+                        (list-to-string
78
+                                (list (nth 1 chars) (nth 2 chars)))
79
+                                :radix 16))))
80
+
0 81
new file mode 100644
... ...
@@ -0,0 +1,34 @@
1
+(defpackage :cgi
2
+	(:use :cl)
3
+	(:export 
4
+		:request-process
5
+		:cookie-create
6
+		:populate-environment
7
+
8
+		*document-root*
9
+		*http-cookie*
10
+		*http-host*
11
+		*http-referer*
12
+		*http-user-agent*
13
+		*https*
14
+		*path*
15
+		*query-string*
16
+		*remote-addr*
17
+		*remote-host*
18
+		*remote-port*
19
+		*remote-user*
20
+		*request-method*
21
+		*request-uri*
22
+		*script-filename*
23
+		*script-name*
24
+		*server-admin*
25
+		*server-name*
26
+		*server-port*
27
+		*server-software*
28
+
29
+		*get*
30
+		*post*
31
+		*cookie*
32
+		))
33
+
34
+(in-package :cgi)
0 35
new file mode 100644
... ...
@@ -0,0 +1,15 @@
1
+This contains a bare-bones CGI web application demo.
2
+
3
+To test it out, configure your web-server to execute ".lisp" files with your
4
+Common Lisp interpreter (tested with GNU Clisp). Then, edit "init.lisp" to
5
+load a file that loads Quicklisp-- by default, "init.lisp" uses the clisprc
6
+of the superuser. You probably wanna change that.
7
+
8
+form.lisp displays *every* CGI environment variable, and shows how cl-cgi
9
+specially parses POST & GET data. Use form.html to submit POST data to
10
+form.lisp. ;-)
11
+
12
+cookie.lisp & cookie.html let you test the creation & parsing of cookies.
13
+GET value of "cookiekind" is set as the cookie "Test-Cookie", then displayed.
14
+You need to refresh the page after setting a cookie, so that it takes effect &
15
+can be displayed, of course. :-D
0 16
new file mode 100644
... ...
@@ -0,0 +1,9 @@
1
+<html>
2
+<head></head>
3
+<body>
4
+	<form action="cookie.lisp" method="get">
5
+		<input type="text" name="cookiekind" placeholder="Your favourite kind of cookie~"/>
6
+		<input type="submit"/>
7
+	</form>
8
+</body>
9
+</html>
0 10
new file mode 100644
... ...
@@ -0,0 +1,29 @@
1
+(load "init.lisp")
2
+
3
+;; To create a cookie, you need to make an HTTP header
4
+;; with "Set-Cookie: NAME=VALUE". cookie-create makes
5
+;; the Cookie section of HTTP header automatically, so
6
+;; you just need to manually create the "Content-Type"
7
+;; section.
8
+
9
+(setq *cookie-type-get*
10
+	(gethash "cookiekind" cgi:*get*))
11
+(setq *cookie-type-cookie*
12
+	(gethash "Test-Cookie" cgi:*cookie*))
13
+
14
+
15
+(format t
16
+	"Content-Type: text/html~%~A~%~%"
17
+	(if *cookie-type-get*
18
+		(cgi:cookie-create
19
+			"Test-Cookie"
20
+			*cookie-type-get*)
21
+		"~%"))
22
+
23
+
24
+(format t "<p>Alright, here's the moment of truth!</p>~%")
25
+(format t "<p>Your favourite type of cookie is...</p>~%")
26
+
27
+(if *cookie-type-cookie*
28
+	(format t "<p>... <b>~A</b>!</p>~%" *cookie-type-cookie*)
29
+	(format t "<p>... oh. You don't have one.</p>"))
0 30
new file mode 100644
... ...
@@ -0,0 +1,12 @@
1
+<html>
2
+<head></head>
3
+<body>
4
+	<form action="form.lisp?id=10" method="post">
5
+		<input type="text" name="texty" placeholder="Text~"/>
6
+		<input type="date" name="datey" placeholder="Date~"/>
7
+		<input type="color" name="colourish" placeholder="Colour~"/>
8
+		<input type="password" name="passy"/>
9
+		<input type="submit"/>
10
+	</form>
11
+</body>
12
+</html>
0 13
new file mode 100644
... ...
@@ -0,0 +1,44 @@
1
+(format t "Content-Type: text/html~%~%")
2
+
3
+(setq *post* (read-line))
4
+
5
+(load "init.lisp")
6
+
7
+
8
+(cgi:populate-environment *post*)
9
+(format t "<html><body><ol>~%")
10
+(mapcar (lambda (x) (format t "<li>~A</li>~%" x))
11
+	(list
12
+		cgi:*document-root*
13
+		cgi:*http-cookie*
14
+		cgi:*http-host*
15
+		cgi:*http-referer*
16
+		cgi:*http-user-agent*
17
+		cgi:*https*
18
+		cgi:*path*
19
+		cgi:*query-string*
20
+		cgi:*remote-addr*
21
+		cgi:*remote-host*
22
+		cgi:*remote-port*
23
+		cgi:*remote-user*
24
+		cgi:*request-method*
25
+		cgi:*request-uri*
26
+		cgi:*script-filename*
27
+		cgi:*script-name*
28
+		cgi:*server-admin*
29
+		cgi:*server-name*
30
+		cgi:*server-port*
31
+		cgi:*server-software*
32
+
33
+		cgi:*post*))
34
+
35
+(format t "</br><hr>~%")
36
+
37
+(format t "<p>So, there was everything <i>raw</i>.</p>~%")
38
+(format t "<p>How about the POST data for each of the fields,")
39
+(format t "but formatted nicely? :-)</p>~%")
40
+
41
+(format t "<b>texty:</b> ~A</br>~%" (gethash "texty" cgi:*post*))
42
+(format t "<b>colourish:</b> ~A</br>~%" (gethash "colourish" cgi:*post*))
43
+(format t "<b>datey:</b> ~A</br>~%" (gethash "datey" cgi:*post*))
44
+(format t "<b>passy:</b> ~A</br></br>~%" (gethash "passy" cgi:*post*))
0 45
new file mode 100644
... ...
@@ -0,0 +1,6 @@
1
+(load "/root/.clisprc.lisp")
2
+(let ((*standard-output* (make-broadcast-stream)))
3
+	(ql:quickload "uiop")
4
+	(ql:quickload "cgi"))
5
+
6
+(cgi:populate-environment)