एक आम लिस्प वेब सर्वर पार्ट दो लिखना

पिछले लेख में, हमने अपना वेब सर्वर विकसित करना शुरू किया। उपयोग के साथ जारी रखें। लिस्प फ़ाइल। इस पैकेज में प्रसंस्करण अनुरोधों के लिए हमारे सभी सहायक कार्य शामिल होंगे। सबसे पहले, चर * रेखा * घोषित करें, हमें भविष्य में इसकी आवश्यकता होगी।

(defvar *new-line* (concatenate 'string (string #\Return) (string #\Newline))) 

हमें एक फ़ंक्शन भी चाहिए जो utf-8 में स्ट्रीम से बाइट्स पढ़ेगा और तुच्छ-यूटीएफ -8 फ़ंक्शन का उपयोग करके उन्हें स्ट्रिंग में बदल देगा : utf-8-बाइट्स-टू-स्ट्रिंग ।

 (defun read-utf-8-string (stream &optional (end 0)) (let ((byte -1) (buffer (make-array 1 :fill-pointer 0 :adjustable t))) (handler-case (loop do (setq byte (read-byte stream)) (if (/= byte end) (vector-push-extend byte buffer)) while (/= byte end)) (end-of-file ())) (trivial-utf-8:utf-8-bytes-to-string buffer))) 

हम बस बाइट्स को पढ़ते हैं इससे पहले कि हम बाइट को मान अंत के साथ प्राप्त करते हैं और बाइट्स के परिणामस्वरूप सरणी को एक स्ट्रिंग में बदल देते हैं। यह फ़ंक्शन दूसरे तरीके से लिखा जा सकता है (अधिक कुशलता से), लेकिन मुझे यहां ऐसा विकल्प मिला। यदि आपके पास कोई अच्छा विचार है, तो मुझे टिप्पणियों में उन्हें देखकर खुशी होगी। एक और समारोह घोषित करें

 (defun response-write (text stream) (trivial-utf-8:write-utf-8-bytes text stream)) 

वह क्लाइंट को उसी प्रारूप में उत्तर लिखने में हमारी मदद करेगा (utf-8)

हमारा वेब सर्वर केवल GET अनुरोधों को संभालने में सक्षम होगा। अगर किसी को दिलचस्पी है, तो वह POST अनुरोधों के प्रसंस्करण को लिख सकता है, लेकिन अब हम GET अनुरोधों के लिए खुद को सीमित कर लेंगे। एक विशिष्ट HTTP GET अनुरोध कुछ इस तरह दिखता है

 GET /path/to/a/resource?param1=paramvalue1¶m1=paramvalu2 HTTP/1.1 \r\n HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n 

पहली बात यह है कि हमें पता है कि वेब सर्वर पर हमें किस प्रकार का अनुरोध मिला है।

 (defun parse-request (stream) (let ((header (read-utf-8-string stream 10))) (if (eq (length header) 0) '() (if (equal (subseq header 0 4) "POST") (parse-post-header header stream) (parse-get-header header stream))))) 

हम POST अनुरोधों के लिए कुछ भी नहीं करने जा रहे हैं, इसलिए हम एक साधारण फ़ंक्शन लिखेंगे

 (defun parse-post-header (header stream) (cons "POST" nil)) 

GET अनुरोध के लिए, हमें अनुरोधित संसाधन और अन्य सभी शीर्ष लेखों का मार्ग प्राप्त करना चाहिए

 (defun parse-get-header (header stream) (cons "GET" (cons (parse-path (subseq header (position #\/ header) (position #\Space header :from-end t))) (parse-headers stream)))) 

इसके लिए हम फ़ंक्शन पार्स-पाथ और पार्स-हेडर्स का उपयोग करेंगे

शुरुआत करते हैं पार्स-पाथ से

 (defun parse-path (path) (if (position #\? path) (cons (subseq path 0 (position #\? path)) (parse-params (subseq path (1+ (position #\? path))))) (cons path nil))) 

जैसा कि आप यहां देख सकते हैं, हम पैरामीटर्स को अलग करते हैं और पैरासे-पारमेस फंक्शन के साथ पैरामीटर्स को अलग - अलग करते हैं

इससे पहले कि हम मापदंडों को पार्स करना शुरू करें, हमें अपने तत्काल मूल्यों के लिए हेक्साडेसिमल में उपयोग किए जाने वाले पात्रों को परिवर्तित करने के लिए एक और सहायक फ़ंक्शन की आवश्यकता है।

 (defun http-char (c1 c2 &optional (default #\Space)) (let ((code (parse-integer (coerce (list c1 c2) 'string) :radix 16 :junk-allowed t))) (if code (code-char code) default))) 

इस फ़ंक्शन को http-char-decode कहा जा सकता है

अब यह हमारे मापदंडों को बदल देता है।

 (defun parse-params (s) (let ((params (decode-params s))) (remove-duplicates params :test (lambda (x1 x2) (equal (car x1) (car x2))) :from-end nil))) (defun decode-params (s) (let ((p1 (position #\& s))) (if p1 (cons (decode-kv (subseq s 0 p1)) (parse-params (subseq s (1+ p1)))) (list (decode-kv s))))) (defun decode-kv (s) (let ((p1 (position #\= s))) (if p1 (cons (decode-param (subseq s 0 p1)) (decode-param (subseq s (1+ p1)))) (cons (decode-param s) nil)))) (defun decode-param (s) (labels ((f (1st) (when 1st (case (car 1st) (#\% (cons (http-char (cadr 1st) (caddr 1st)) (f (cdddr 1st)))) (#\+ (cons #\Space (f (cdr 1st)))) (otherwise (cons (car 1st) (f (cdr 1st)))))))) (coerce (f (coerce s 'list)) 'string))) 

जैसा कि आप देख सकते हैं, हम इसके लिए डीकोड-पैराम्स का उपयोग करते हैं, जो बदले में फिर से पार्स-परम को कॉल करते हैं, जो डिकोड-केवी के साथ नाम = मान पैरामीटर को पूर्व-पार्स करने के बाद पुन: पार्स करता है। अंत में, हम सहायक फ़ंक्शन डिकोड-परम का उपयोग करते हैं, जो विशेष http वर्णों को अलग करता है और पहले से ही http-char रिटर्निंग डेटा का उपयोग करके उन्हें परिवर्तित करता है

हमारा पार्स-परम तैयार है, यह पार्स-हेडर्स फ़ंक्शन लिखने के लिए बना हुआ है, यहां सब कुछ बहुत सरल है

 (defun parse-headers (stream) (let ((headers nil) (header nil)) (loop do (setq header (read-utf-8-string stream 10)) (if (> (length header) 2) (setq headers (cons (parse-header header) headers))) while (> (length header) 2)) (reverse headers))) (defun parse-header (header) (let ((pos (position #\: header))) (if pos (cons (string-downcase (subseq header 0 pos)) (string-trim (concatenate 'string (string #\Space) (string #\Return)) (subseq header (1+ pos))))))) 

हम पहली बार स्ट्रिंग का उपयोग करते हैं (रीड-यूटीएफ-8-स्ट्रिंग स्ट्रीम 10), जहां एएससीआईआई में 10 मान \ n है और यदि यह दो से अधिक अक्षर है, तो इसे पार्स-हेडर के साथ पार्स करें। नतीजतन, हम सभी शीर्षकों से अलग हो जाते हैं।

इस पर, पार्स-गेट-हेडर तैयार है और उसे प्रकार की संरचना वापस करनी चाहिए

 '("GET" ("path/to/file" (("param1" . "value1") ("param2" . "value2"))) (("header1" . "value1") ("header2" . "value2"))) 

इस संरचना के साथ काम करने की सुविधा के लिए, हम दो सहायक कार्यों को जोड़ते हैं

 (defun get-param (name request) (cdr (assoc name (cdadr request) :test #'equal))) (defun get-header (name request) (cdr (assoc (string-downcase name) (cddr request) :test #'equal))) 

अब हमारे पास एक अनुरोध है, हम ग्राहक को एक प्रतिक्रिया भेज सकते हैं। एक ठेठ जवाब कुछ इस तरह दिखता है

 HTTP/1.1 200 OK HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n Data 

हम सहायक कार्यों के एक जोड़े को लिखेंगे जो उत्तर के साथ काम करने में हमारी मदद करेंगे

 (defun http-response (code headers stream) (response-write (concatenate 'string "HTTP/1.1 " code *new-line*) stream) (mapcar (lambda (header) (response-write (concatenate 'string (car header) ": " (cdr header) *new-line*) stream)) headers) (response-write *new-line* stream)) (defun http-404-not-found (message stream) (http-response "404 Not Found" nil stream) (response-write message stream)) 

जैसा कि आप यहां देख सकते हैं, सब कुछ सरल भी है।

अब यह एक फ़ंक्शन लिखने के लिए है जो हमें वेब निर्देशिका से फाइलें देगा

 (defun file-response (filename type request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (if (equal (get-header "if-modified-since" request) (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (http-response "304 Not Modified" nil stream) (progn (http-response "200 OK" (cons (cons "Last-Modified" (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (cons (cons "Content-Type" type) nil)) stream) (let ((buf (make-array 4096 :element-type (stream-element-type in)))) (loop for pos = (read-sequence buf in) while (plusp pos) do (write-sequence buf stream :end pos))) ))) (file-error () (http-404-not-found "404 File Not Found" stream) ))) 

यह हमारे वेब सर्वर को छवियों और HTML पृष्ठों जैसी फ़ाइलों को वापस करने की अनुमति देगा। उसी समय, हम लास्ट-मॉडिफाइड हेडर को भी लास्ट फाइल मॉडिफिकेशन की तारीख से लौटाते हैं। यदि हमें हेडर के साथ दूसरी बार उसी फाइल के लिए अनुरोध मिलता है यदि संशोधित-चूंकि, तो हम फ़ाइल के अंतिम संशोधन की तारीख के साथ तारीख को फ्रीज कर देंगे। यदि तारीख नहीं बदली गई है, तो इसका मतलब है कि वेब ब्राउज़र के पास अपने कैश में फ़ाइल का नवीनतम संस्करण है, इसलिए हम केवल कोड 304 को संशोधित करते हैं

अब हम दूसरा html- टेम्प्लेट फ़ंक्शन लिखेंगे, जो वेब निर्देशिका से कोई भी टेक्स्ट फ़ाइल लेगा और समान नामों के साथ एलिस्ट सूची में निर्दिष्ट मानों के साथ $ {name} के मानों को बदल देगा। एक प्रकार का आदिम टेम्पलेट इंजन

 (defun html-template (filename type params request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (loop for line = (read-utf-8-string in 10) while (and line (> (length line) 0)) do (progn (mapcar (lambda (i) (let* ((key (concatenate 'string "${" (car i) "}"))) (loop for pos = (search key line) while pos do (setq line (concatenate 'string (subseq line 0 pos) (cdr i) (subseq line (+ pos (length key))))) ) )) params) (response-write line stream) (response-write (string #\Return) stream)) ) ) (file-error () (http-404-not-found "404 File Not Found" stream) ))) 

इस पर हमारा उपयोग। लिस्प लगभग तैयार है, यह केवल लॉग के लिए फ़ंक्शन लिखने के लिए रहता है। चलो log.lisp फ़ाइल में सीएल-लॉग कॉन्फ़िगरेशन के साथ शुरू करते हैं

 (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) (start-messenger 'text-file-messenger :filename "log/web.log") (defmethod format-message ((self formatted-message)) (format nil "~a ~a ~?~&" (local-time:format-timestring nil (local-time:universal-to-timestamp (timestamp-universal-time (message-timestamp self)))) (message-category self) (message-description self) (message-arguments self))) 

यहां सब कुछ मानक है, केवल एक चीज जो हमने बदली है वह है प्रारूप-संदेश जहां हम केवल एक स्वरूपित रूप में दिनांक प्रदर्शित करते हैं।

अब उपयोग करने के लिए लॉगिंग के लिए एक फ़ंक्शन जोड़ें। लिस्प जो एक अलग थ्रेड में एक ही समय में प्रति सेकंड 1 से अधिक समय में संदेश लॉग करेगा। सीधे लॉगिंग से लोडिंग को हटाने की अनुमति क्या होगी

 (defvar *log-queue-lock* (bt:make-lock)) (defvar *log-queue-cond* (bt:make-condition-variable)) (defvar *log-queue-cond-lock* (bt:make-lock)) (defvar *log-queue* nil) (defvar *log-queue-time* (get-universal-time)) (defun log-worker () (bt:with-lock-held (*log-queue-lock*) (progn (mapcar (lambda (i) (if (cdr i) (cl-log:log-message (car i) (cdr i)))) (reverse *log-queue*)) (setq *log-queue* nil) )) (bt:with-lock-held (*log-queue-cond-lock*) (bt:condition-wait *log-queue-cond* *log-queue-cond-lock*) ) (log-worker)) (bt:make-thread #'log-worker :name "log-worker") 

इसके लिए हम सहायक लॉगिंग फ़ंक्शन का उपयोग करेंगे

 (defun log-info (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :info message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-warning (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :warning message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-error (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :error message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) 

यह हैंडलर.लिस्प में प्रक्रिया-अनुरोध को जोड़ने और हमारे कार्यों का प्रयास करने के लिए बनी हुई है

 (defun process-request (request stream) (let ((path (caadr request))) (cond ((equal path "/logo.jpg") (myweb.util:file-response "logo.jpg" "image/jpeg" request stream)) (t (process-index request stream))))) (defun process-index (request stream) (let ((name (myweb.util:get-param "name" request))) (if (and name (> (length name) 0)) (myweb.util:html-template "index.html" "text/html;encoding=UTF-8" `(("name" . ,name)) request stream) (myweb.util:html-template "name.html" "text/html;encoding=UTF-8" nil request stream) ))) 

वेब फ़ोल्डर में एक index.html फ़ाइल बनाएँ

 <html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h1>Hello ${name}</h1> </body> </html> 

और name.html फ़ाइल

 <html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h2>Hello stranger. What's your name?</h2> <form action="/" method="GET"> Name: <input type="text" name="name"> <input type="submit" value="Submit"> </form> </body> </html> 

और वहाँ एक सुंदर logo.jpg रखना मत भूलना

वेब सर्वर का उपयोग करना शुरू करें (myweb: start-http "localhost" 8080) और स्थानीयहोस्ट पर जाएं: 8080 ब्राउज़र

आपका ध्यान देने के लिए धन्यवाद।