<commit_before>;;; Copyright (C) 2001, 2003  <NAME>
;;; Copyright (C) 2005  <NAME>
;;; Copyright (C) 2007  Pixel // pinterface
;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
;;;
;;; See LICENSE for details.

(eval-when (:compile-toplevel)
  (declaim
   (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0))))

(in-package :cl+ssl)

(defclass ssl-stream
    (fundamental-binary-input-stream
     fundamental-binary-output-stream 
     trivial-gray-stream-mixin)
  ((ssl-stream-socket
    :initarg :socket
    :accessor ssl-stream-socket)
   (close-callback
    :initarg :close-callback
    :accessor ssl-close-callback)
   (handle
    :initform nil
    :accessor ssl-stream-handle)
   (deadline
    :initform nil
    :initarg :deadline
    :accessor ssl-stream-deadline)
   (output-buffer
    :initform (make-buffer +initial-buffer-size+)
    :accessor ssl-stream-output-buffer)
   (output-pointer
    :initform 0
    :accessor ssl-stream-output-pointer)
   (input-buffer
    :initform (make-buffer +initial-buffer-size+)
    :accessor ssl-stream-input-buffer)
   (peeked-byte
    :initform nil
    :accessor ssl-stream-peeked-byte)))

(defmethod print-object ((object ssl-stream) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "for ~A" (ssl-stream-socket object))))

(defclass ssl-server-stream (ssl-stream) 
  ((certificate
    :initarg :certificate
    :accessor ssl-stream-certificate)
   (key
    :initarg :key
    :accessor ssl-stream-key)))

(defmethod stream-element-type ((stream ssl-stream))
  '(unsigned-byte 8))

(defmethod close ((stream ssl-stream) &key abort)
  (cond
    ((ssl-stream-handle stream)
     (unless abort
       (force-output stream))
     (ssl-free (ssl-stream-handle stream))
     (setf (ssl-stream-handle stream) nil)
     (when (streamp (ssl-stream-socket stream))
       (close (ssl-stream-socket stream)))
     (when (functionp (ssl-close-callback stream))
       (funcall (ssl-close-callback stream)))
     t)
    (t
     nil)))

(defmethod open-stream-p ((stream ssl-stream))
  (and (ssl-stream-handle stream) t))

(defmethod stream-listen ((stream ssl-stream))
  (or (ssl-stream-peeked-byte stream)
      (setf (ssl-stream-peeked-byte stream)
            (let* ((*blockp* nil)
                   (b (stream-read-byte stream)))
              (if (eql b :eof) nil b)))))

(defmethod stream-read-byte ((stream ssl-stream))
  (or (ssl-stream-peeked-byte stream)
      (let ((buf (ssl-stream-input-buffer stream)))
        (handler-case
            (with-pointer-to-vector-data (ptr buf)
              (ensure-ssl-funcall stream
                                  (ssl-stream-handle stream)
                                  #'ssl-read
                                  (ssl-stream-handle stream)
                                  ptr
                                  1)
              (buffer-elt buf 0))
          (ssl-error-zero-return ()     ;SSL_read returns 0 on end-of-file
            :eof)))))

(defmethod stream-read-sequence ((stream ssl-stream) thing start end &key)
  (check-type thing (simple-array (unsigned-byte 8) (*)))
  (when (and (< start end) (ssl-stream-peeked-byte stream))
    (setf (elt thing start) (ssl-stream-peeked-byte stream))
    (setf (ssl-stream-peeked-byte stream) nil)
    (incf start))
  (let ((buf (ssl-stream-input-buffer stream)))
    (loop
        for length = (min (- end start) (buffer-length buf))
        while (plusp length)
        do
          (handler-case
              (with-pointer-to-vector-data (ptr buf)
                (ensure-ssl-funcall stream
                                    (ssl-stream-handle stream)
                                    #'ssl-read
                                    (ssl-stream-handle stream)
                                    ptr
                                    length)
                (v/b-replace thing buf :start1 start :end1 (+ start length))
                (incf start length))
            (ssl-error-zero-return ()   ;SSL_read returns 0 on end-of-file
              (return))))
    ;; fixme: kein out-of-file wenn (zerop start)?
    start))

(defmethod stream-write-byte ((stream ssl-stream) b)
  (let ((buf (ssl-stream-output-buffer stream)))
    (when (eql (buffer-length buf) (ssl-stream-output-pointer stream))
      (force-output stream))
    (setf (buffer-elt buf (ssl-stream-output-pointer stream)) b)
    (incf (ssl-stream-output-pointer stream)))
  b)

(defmethod stream-write-sequence ((stream ssl-stream) thing start end &key)
  (check-type thing (simple-array (unsigned-byte 8) (*)))
  (let ((buf (ssl-stream-output-buffer stream)))
    (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (buffer-length buf))
      ;; not enough space left?  flush buffer.
      (force-output stream)
      ;; still doesn't fit?
      (while (> (- end start) (buffer-length buf))
        (b/v-replace buf thing :start2 start)
        (incf start (buffer-length buf))
        (setf (ssl-stream-output-pointer stream) (buffer-length buf))
        (force-output stream)))
    (b/v-replace buf thing
                 :start1 (ssl-stream-output-pointer stream)
                 :start2 start
                 :end2 end)
    (incf (ssl-stream-output-pointer stream) (- end start)))
  thing)

(defmethod stream-finish-output ((stream ssl-stream))
  (stream-force-output stream))

(defmethod stream-force-output ((stream ssl-stream))
  (let ((buf (ssl-stream-output-buffer stream))
        (fill-ptr (ssl-stream-output-pointer stream))
        (handle (ssl-stream-handle stream)))
    (when (plusp fill-ptr)
      (unless handle
	(error "output operation on closed SSL stream"))
      (with-pointer-to-vector-data (ptr buf)
        (ensure-ssl-funcall stream handle #'ssl-write handle ptr fill-ptr))
      (setf (ssl-stream-output-pointer stream) 0))))

#+clozure-common-lisp
(defun install-nonblock-flag (fd)
  (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd) 
                     #.(read-from-string "#$O_NONBLOCK"))))
                     ;; read-from-string is necessary because
                     ;; CLISP and perhaps other Lisps are confused
                     ;; by #$, signaling"undefined dispatch character $", 
                     ;; even though the defun in conditionalized by 
                     ;; #+clozure-common-lisp
                    
#+(and sbcl (not win32))
(defun install-nonblock-flag (fd)
  (sb-posix:fcntl fd
		  sb-posix::f-setfl
		  (logior (sb-posix:fcntl fd sb-posix::f-getfl)
			  sb-posix::o-nonblock)))

#-(or clozure-common-lisp (and sbcl (not win32)))
(defun install-nonblock-flag (fd)
  (declare (ignore fd)))


;;; interface functions
;;;

(defun install-handle-and-bio (stream handle socket unwrap-stream-p)
  (setf (ssl-stream-handle stream) handle)
  (when unwrap-stream-p
    (let ((fd (stream-fd socket)))
      (when fd<commit_msg>Compile fix for CCL on Windows.<commit_after>;;; Copyright (C) 2001, 2003  <NAME>
;;; Copyright (C) 2005  <NAME>
;;; Copyright (C) 2007  Pixel // pinterface
;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
;;;
;;; See LICENSE for details.

(eval-when (:compile-toplevel)
  (declaim
   (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0))))

(in-package :cl+ssl)

(defclass ssl-stream
    (fundamental-binary-input-stream
     fundamental-binary-output-stream 
     trivial-gray-stream-mixin)
  ((ssl-stream-socket
    :initarg :socket
    :accessor ssl-stream-socket)
   (close-callback
    :initarg :close-callback
    :accessor ssl-close-callback)
   (handle
    :initform nil
    :accessor ssl-stream-handle)
   (deadline
    :initform nil
    :initarg :deadline
    :accessor ssl-stream-deadline)
   (output-buffer
    :initform (make-buffer +initial-buffer-size+)
    :accessor ssl-stream-output-buffer)
   (output-pointer
    :initform 0
    :accessor ssl-stream-output-pointer)
   (input-buffer
    :initform (make-buffer +initial-buffer-size+)
    :accessor ssl-stream-input-buffer)
   (peeked-byte
    :initform nil
    :accessor ssl-stream-peeked-byte)))

(defmethod print-object ((object ssl-stream) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "for ~A" (ssl-stream-socket object))))

(defclass ssl-server-stream (ssl-stream) 
  ((certificate
    :initarg :certificate
    :accessor ssl-stream-certificate)
   (key
    :initarg :key
    :accessor ssl-stream-key)))

(defmethod stream-element-type ((stream ssl-stream))
  '(unsigned-byte 8))

(defmethod close ((stream ssl-stream) &key abort)
  (cond
    ((ssl-stream-handle stream)
     (unless abort
       (force-output stream))
     (ssl-free (ssl-stream-handle stream))
     (setf (ssl-stream-handle stream) nil)
     (when (streamp (ssl-stream-socket stream))
       (close (ssl-stream-socket stream)))
     (when (functionp (ssl-close-callback stream))
       (funcall (ssl-close-callback stream)))
     t)
    (t
     nil)))

(defmethod open-stream-p ((stream ssl-stream))
  (and (ssl-stream-handle stream) t))

(defmethod stream-listen ((stream ssl-stream))
  (or (ssl-stream-peeked-byte stream)
      (setf (ssl-stream-peeked-byte stream)
            (let* ((*blockp* nil)
                   (b (stream-read-byte stream)))
              (if (eql b :eof) nil b)))))

(defmethod stream-read-byte ((stream ssl-stream))
  (or (ssl-stream-peeked-byte stream)
      (let ((buf (ssl-stream-input-buffer stream)))
        (handler-case
            (with-pointer-to-vector-data (ptr buf)
              (ensure-ssl-funcall stream
                                  (ssl-stream-handle stream)
                                  #'ssl-read
                                  (ssl-stream-handle stream)
                                  ptr
                                  1)
              (buffer-elt buf 0))
          (ssl-error-zero-return ()     ;SSL_read returns 0 on end-of-file
            :eof)))))

(defmethod stream-read-sequence ((stream ssl-stream) thing start end &key)
  (check-type thing (simple-array (unsigned-byte 8) (*)))
  (when (and (< start end) (ssl-stream-peeked-byte stream))
    (setf (elt thing start) (ssl-stream-peeked-byte stream))
    (setf (ssl-stream-peeked-byte stream) nil)
    (incf start))
  (let ((buf (ssl-stream-input-buffer stream)))
    (loop
        for length = (min (- end start) (buffer-length buf))
        while (plusp length)
        do
          (handler-case
              (with-pointer-to-vector-data (ptr buf)
                (ensure-ssl-funcall stream
                                    (ssl-stream-handle stream)
                                    #'ssl-read
                                    (ssl-stream-handle stream)
                                    ptr
                                    length)
                (v/b-replace thing buf :start1 start :end1 (+ start length))
                (incf start length))
            (ssl-error-zero-return ()   ;SSL_read returns 0 on end-of-file
              (return))))
    ;; fixme: kein out-of-file wenn (zerop start)?
    start))

(defmethod stream-write-byte ((stream ssl-stream) b)
  (let ((buf (ssl-stream-output-buffer stream)))
    (when (eql (buffer-length buf) (ssl-stream-output-pointer stream))
      (force-output stream))
    (setf (buffer-elt buf (ssl-stream-output-pointer stream)) b)
    (incf (ssl-stream-output-pointer stream)))
  b)

(defmethod stream-write-sequence ((stream ssl-stream) thing start end &key)
  (check-type thing (simple-array (unsigned-byte 8) (*)))
  (let ((buf (ssl-stream-output-buffer stream)))
    (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (buffer-length buf))
      ;; not enough space left?  flush buffer.
      (force-output stream)
      ;; still doesn't fit?
      (while (> (- end start) (buffer-length buf))
        (b/v-replace buf thing :start2 start)
        (incf start (buffer-length buf))
        (setf (ssl-stream-output-pointer stream) (buffer-length buf))
        (force-output stream)))
    (b/v-replace buf thing
                 :start1 (ssl-stream-output-pointer stream)
                 :start2 start
                 :end2 end)
    (incf (ssl-stream-output-pointer stream) (- end start)))
  thing)

(defmethod stream-finish-output ((stream ssl-stream))
  (stream-force-output stream))

(defmethod stream-force-output ((stream ssl-stream))
  (let ((buf (ssl-stream-output-buffer stream))
        (fill-ptr (ssl-stream-output-pointer stream))
        (handle (ssl-stream-handle stream)))
    (when (plusp fill-ptr)
      (unless handle
	(error "output operation on closed SSL stream"))
      (with-pointer-to-vector-data (ptr buf)
        (ensure-ssl-funcall stream handle #'ssl-write handle ptr fill-ptr))
      (setf (ssl-stream-output-pointer stream) 0))))

#+(and clozure-common-lisp (not windows))
(defun install-nonblock-flag (fd)
  (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd) 
                     #.(read-from-string "#$O_NONBLOCK"))))
                     ;; read-from-string is necessary because
                     ;; CLISP and perhaps other Lisps are confused
                     ;; by #$, signaling"undefined dispatch character $", 
                     ;; even though the defun in conditionalized by 
                     ;; #+clozure-common-lisp
                    
#+(and sbcl (not win32))
(defun install-nonblock-flag (fd)
  (sb-posix:fcntl fd
		  sb-posix::f-setfl
		  (logior (sb-posix:fcntl fd sb-posix::f-getfl)
			  sb-posix::o-nonblock)))

#-(or (and clozure-common-lisp (not windows)) (and sbcl (not win32)))
(defun install-nonblock-flag (fd)
  (declare (ignore fd)))


;;; interface functions
;;;

(defun install-handle-and-bio (stream handle socket unwrap-stream-p)
  (setf (ssl-stream-handle stream) handle)
  (when unwrap-stream-p
    (let ((fd (stream-fd socket)))
      (when fd
{'fraction_non_alphanumeric': 0.1362518089725036, 'fraction_numerical': 0.005788712011577424, 'mean_word_length': 2.2558303886925795, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4113129', 'n_tokens_mistral': 4479, 'n_tokens_neox': 4290, 'n_words': 1088}