Регистрация | Войти
Lisp — программируемый язык программирования
iolib multiple download
Автор: turtle - 2011-05-05T15:53:08.000000+04:00
;;;; -*- mode: lisp -*-

(defpackage #:iolib-download
  (:use #:cl
        #:iolib
)
)


(in-package #:iolib-download)

(defparameter *event-base* nil)

(defparameter *download-queue* 0)

(defun create-get-request (host path)
  (sb-ext:string-to-octets
   (let ((cr-lf (concatenate 'string '(#\Return #\Newline))))
     (with-output-to-string (sstream)
       (format sstream "GET ~a HTTP/1.1~a" path cr-lf)
       (format sstream "Host: ~a~a" host cr-lf)
       (format sstream "Accept: */*~a" cr-lf)
       (format sstream "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 98)~a" cr-lf)
       (format sstream "Referer: http://~a/~a" host cr-lf)
       (format sstream "~a" cr-lf)
)
)
)
)


(defun socket-disconnector (socket &rest events)
  (let ((fd (socket-os-fd socket)))
    (if (not (intersection '(:read :write :error) events))
        (remove-fd-handlers *event-base* fd :read t :write t :error t)
        (progn
          (when (member :read events)
            (remove-fd-handlers *event-base* fd :read t)
)

          (when (member :write events)
            (remove-fd-handlers *event-base* fd :write t)
)

          (when (member :error events)
            (remove-fd-handlers *event-base* fd :error t)
)
)
)
)

  (when (member :close events)
    (multiple-value-bind (who port)
        (remote-name socket)
      (format t "Closing connection to ~a:~a~%" who port)
      (close socket)
)
)
)


(defun make-ul-handler (socket-to host path)
  (let ((start-byte 0)
        (request (create-get-request host path))
)

    (lambda (fd event exception)
      (declare (ignore fd event exception))
      (let ((wrote-bytes (send-to socket-to request
                                  :start start-byte
)
)
)

        #+nil(format t "Wrote bytes ~a~%" wrote-bytes)
        #+nil(format t "b ~a,~a~%" (+ start-byte wrote-bytes) (length request))
        (if (not (= (+ start-byte wrote-bytes) (length request)))
            (setf start-byte wrote-bytes)
            (progn
              (finish-output)
              (socket-disconnector socket-to :write)
)
)
)
)
)
)


(defun make-dl-handler (socket-to host path)
  (let ((fstream (open (map 'string
                            #'(lambda (char)
                                (if (eq char #\/)
                                    #\_
                                    char
)
)

                            (format nil "~a/~a" host path)
)

                       :direction :output
                       :element-type '(unsigned-byte 8)
                       :if-exists :supersede
                       :if-does-not-exist :create
)
)
)

    (lambda (fd event exception)
      (declare (ignore fd event exception))
      (multiple-value-bind (buffer bytes-read)
          (receive-from socket-to
                        :size 4096
)

        (if (not (zerop bytes-read))
            (progn
              #+nil(format t "Received ~a bytes~%" bytes-read)
              (write-sequence buffer fstream :end bytes-read)
)

            (progn
              (socket-disconnector socket-to :close)
              (close fstream)
              #+nil(format t "queue: ~a~%" *download-queue*)
              (decf *download-queue*)
              (if (zerop *download-queue*)
                  (exit-event-loop *event-base*)
)
)
)
)
)
)
)


(defun enqueue-download (host path)
  (let ((socket-to (make-socket :connect :active
                                :address-family :internet
                                :type :stream
                                :ipv6 nil
)
)
)

    (connect socket-to (lookup-hostname host) :port 80)
    (set-io-handler *event-base*
                    (socket-os-fd socket-to)
                    :write (make-ul-handler socket-to host path)
)

    (set-io-handler *event-base*
                    (socket-os-fd socket-to)
                    :read (make-dl-handler socket-to host path)
)

    (incf *download-queue*)
)
)


;; "download-list - list like '(("lisper.ru" "/planet/"))"
(defun initiate-download (download-list)
  (setf *event-base* (make-instance 'event-base))
  #+nil(enqueue-download "lisper.ru" "/planet/")
  (loop for dl-spec in download-list
       do (enqueue-download (first dl-spec)
                            (second dl-spec)
)
)

  (event-dispatch *event-base* :max-step 1)
)


;; (initiate-download '(("lisper.ru" "/planet/") ("fprog.ru" "/planet/")))
@2009-2013 lisper.ru