;;;; hhgbot.lisp (in-package #:hhgbot) (eval-when (:compile-toplevel :load-toplevel :execute) (set-dispatch-macro-character #\# #\{ (lambda (stream char param) (declare (ignore char param)) (let ((elems (read-delimited-list #\} stream t)) (rest-sym (gensym "rest"))) `(lambda (&rest ,rest-sym) (apply ',(car elems) ,@(cdr elems) ,rest-sym))))) (set-macro-character #\} (get-macro-character #\) nil))) (defparameter *api-token* "DEL") (defun write-crlf (stream) (format stream "~c" #\linefeed)) (defun write-crlf (stream) (format stream "~c~c" #\return #\linefeed)) ; GET /websocket/lEEwhrr2xA4rxHXxY0bPY7Ir06hXul4yhvYfIN2iU8-zBRIHrDIMfTDhIzbs67fAKy0Iw2wrLY1mggMTkO1xAq8WtGTVYMtdE4HhP7jWQrLJNxfSsneGAuvAN_wGWvW9cPxv6hLBjFfA_QQl3FFwHnspEQelNdKGj8ISdIsYYLI= HTTP/1.1 ; ; Host: mpmulti-y1d8.slack-msgs.com:443 ; Upgrade: WebSocket ; Connection: Upgrade ; Pragma: no-cache ; Cache-Control: no-cache ; Sec-WebSocket-Key: fcat0W4ssKWT29LZoAKgaw== ; Sec-WebSocket-Version: 13 (defun format-with-crlf (s control &rest args) (apply #'format s control args) (write-crlf s)) (defun make-connection-string (puri &optional s) ;(let ((s (make-broadcast-stream *standard-output* s))) (fresh-line s) (format-with-crlf s "GET ~a HTTP/1.1" (puri:uri-path puri)) (format-with-crlf s "Host: ~a:443" (puri:uri-host puri)) (format-with-crlf s "User-Agent: hhgbot") (format-with-crlf s "Upgrade: websocket") (format-with-crlf s "Connection: Upgrade") (format-with-crlf s "Pragma: no-cache") (format-with-crlf s "Cache-Control: no-cache") (format-with-crlf s "Sec-WebSocket-Key: fcat0W4ssKWT29LZoAKgaw==") (format-with-crlf s "Sec-WebSocket-Version: 13") (format-with-crlf s "") (finish-output s) );) (defclass content-type () ((%genus :initarg :genus :initform (error "need a genus") :reader genus) (%species :initarg :species :initform (error "need a species") :reader species) (%metadata :initarg :metadata :initform '() :reader metadata))) (defmethod print-object ((object content-type) s) (print-unreadable-object (object s :type t :identity t) (format s "~a/~a ~s" (genus object) (species object) (metadata object) ))) (defgeneric parse-header-value (key value) (:method (key value) value)) (defmethod parse-header-value ((key (eql :content-length)) value) (parse-integer value)) (defmethod parse-header-value ((key (eql :expires)) value) (parse-integer value)) (defmethod parse-header-value ((key (eql :content-type)) value) (let ((parts (mapcar (plambda (string-trim '(#\space #\tab) :1)) (split-sequence:split-sequence #\; value)))) (destructuring-bind (content-type . parameters) parts (destructuring-bind (type subtype) (split-sequence:split-sequence #\/ content-type) (make-instance 'content-type :genus type :species subtype :metadata (mapcar (plambda (funcall (alexandria:compose #'alexandria:make-keyword #'string-upcase) (split-sequence:split-sequence #\= :1))) parameters)))))) (defun parse-header (header-string) (declare (optimize (debug 3))) (let ((keywords-to-remove '())) (flet ((temp-keyword (name) (declare (optimize (debug 3))) (multiple-value-bind (keyword status) (funcall (alexandria:compose #'alexandria:make-keyword #'string-upcase) name)))) (let* ((sep-position (position #\: header-string)) (name (alexandria:make-keyword (string-upcase (subseq header-string 0 sep-position)))) (value (subseq header-string (+ 2 sep-position)))) (cons name (parse-header-value name value)))))) (defun get-google (puri char-stream &optional (ostream char-stream)) (make-connection-string puri ostream) (loop with buf = (make-string 1) for q = (read-sequence buf char-stream) when (> q 0) do (princ buf))) (defun ssl-connect (puri port continuation) (let ((hn (puri:uri-host puri))) (usocket:with-client-socket (socket stream hn port :element-type '(unsigned-byte 8)) (let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream :hostname hn)) (char-stream (flexi-streams:make-flexi-stream ssl-stream :external-format '(:utf-8)))) (unwind-protect (progn (format t "~a~%" puri) (funcall continuation puri char-stream char-stream)) (close ssl-stream)))))) (progn (defparameter *ws-url* (puri:parse-uri (funcall (alexandria:compose #'cdr (plambda (assoc "url" :1 :test #'string-equal))) (yason:parse (drakma:http-request (format nil "https://slack.com/api/rtm.start?token=~a" *api-token*) :want-stream t) :object-as :alist))) ) (make-connection-string *ws-url* t) (format t "'~a~%" *ws-url*) ) (let ((headers '()) (body '()) (body-count 0) (tmp-header-string nil) (mode :header) (*ws-url* (puri:parse-uri (funcall (alexandria:compose #'cdr (plambda (assoc "url" :1 :test #'string-equal))) (yason:parse (drakma:http-request (format nil "https://slack.com/api/rtm.start?token=~a" *api-token*) :want-stream t) :object-as :alist))))) (as:start-event-loop (lambda () (declare (optimize (debug 3))) (cl-async-ssl:tcp-ssl-connect "slack.com" 443 (lambda (socket data) (let* ((data (babel:octets-to-string data))) (when tmp-header-string (psetf data (concatenate 'string tmp-header-string data) tmp-header-string nil)) (case mode (:header (loop for next-divide = (position #\return data) while next-divide for next-header = (subseq data 0 next-divide) until (string= next-header "") when (alexandria:starts-with-subseq "HTTP" next-header) do (format t "Initial line: ~a~%" next-header) unless (alexandria:starts-with-subseq "HTTP" next-header) do (push (parse-header next-header) headers) (format t "GOT: ~s~%" (car headers)) when (< next-divide (1- (length data))) do (setf data (subseq data (+ 2 next-divide))) finally (when (> (length data) 0) (setf tmp-header-string data)) (when (string= next-header "") (setf mode :body) (push data body) (incf body-count (length data)) (setf tmp-header-string "")))) (:body (push data body) (incf body-count (length data)))) (format t "loop done, body count: ~d, content-length ~d ~%" body-count (cdr (assoc :content-length headers))) (when (>= body-count (or (cdr (assoc :content-length headers)) 0)) (as:close-socket socket)))) :event-cb (lambda (ev) (format t "EV: ~a~%" ev)) :read-timeout 3 :data (with-output-to-string (s) (make-connection-string *ws-url* s))))) (values headers (apply #'concatenate 'string body)))