<commit_before>;;;; Copyright (c) 2011-2016 <NAME> <<EMAIL>>
;;;; This code is licensed under the MIT license.

;;; Simple remote file protocol client.

(defpackage :mezzano.file-system.remote
  (:export #:add-remote-file-host
           #:test-host-connectivity)
  (:use #:cl #:mezzano.file-system)
  (:local-nicknames (:gray :mezzano.gray)))

(in-package :mezzano.file-system.remote)

(defvar *reuse-connection* t
  "If true, then the FS will attempt to maintain a single connection to
the server instead of reconnecting for each operation.")
(defvar *connection-idle-timeout* 60
  "Disconnect the reused connection if idle for this long.")
(defvar *default-remote-file-port* 2599)
(defvar *cache-size* (* 512 1024))

(defclass remote-file-host (file-system-host)
  ((%name :initarg :name :reader host-name)
   (%address :initarg :address :reader host-address)
   (%port :initarg :port :reader host-port)
   (%lock :reader remote-host-lock)
   (%connection :initform nil :accessor remote-host-connection))
  (:default-initargs :port *default-remote-file-port*))

(defmethod initialize-instance :after ((instance remote-file-host) &key)
  (setf (slot-value instance '%lock) (mezzano.supervisor:make-mutex `(remote-file-host ,instance))))

(defmethod print-object ((object remote-file-host) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~S ~S:~S"
            (host-name object)
            (host-address object)
            (host-port object))))

(defmethod host-default-device ((host remote-file-host))
  nil)

(defclass remote-file-stream (gray:fundamental-binary-input-stream
                              gray:fundamental-binary-output-stream
                              file-stream)
  ((%path :initarg :path :reader path)
   (%pathname :initarg :pathname :reader file-stream-pathname)
   (%host :initarg :host :reader host)
   (%position :initarg :position :accessor file-position*)
   (%length :initarg :length :accessor file-length*)
   (%direction :initarg :direction :reader direction)
   ;; The buffer.
   (%buffer :initform nil :accessor buffer)
   ;; File position where the buffer data starts.
   (%buffer-position :accessor buffer-position)
   ;; True when the buffer has been written to.
   (%buffer-dirty-p :initform nil :accessor buffer-dirty-p)
   (%abort-action :initarg :abort-action :accessor abort-action))
  (:default-initargs :position 0))

(defclass remote-file-character-stream (gray:fundamental-character-input-stream
                                        gray:fundamental-character-output-stream
                                        mezzano.internals::external-format-mixin
                                        remote-file-stream
                                        gray:unread-char-mixin)
  ())

(defmethod print-object ((object remote-file-stream) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~S ~A"
            (host-name (host object))
            (path object))))

(defun add-remote-file-host (name address &key (port *default-remote-file-port*))
  (setf (find-host name)
        (make-instance 'remote-file-host
                       :name (string-upcase name)
                       :address address
                       :port port)))

(defmethod parse-namestring-using-host ((host remote-file-host) namestring junk-allowed)
  (when junk-allowed
    (error "TODO: Junk-allowed"))
  (let ((start 0)
        (end (length namestring))
        (directory '())
        (name nil)
        (type nil)
        (version nil))
    (when (eql start end)
      (return-from parse-namestring-using-host (make-pathname :host host)))
    (cond ((eql (char namestring start) #\/)
           (push :absolute directory)
           (incf start))
          (t (push :relative directory)))
    ;; Last element is the name.
    (do* ((x (mezzano.internals::explode #\/ namestring start end) (cdr x)))
         ((null (cdr x))
          (let* ((name-element (car x))
                 (end (length name-element)))
            (unless (zerop (length name-element))
              ;; Check for a trailing ~ indicating a backup.
              (when (and (eql (char name-element (1- end)) #\~)
                         (not (eql (length name-element) 1)))
                (decf end)
                (setf version :previous))
              ;; Find the last dot.
              (let ((dot-position (position #\. name-element :from-end t)))
                (cond ((and dot-position (not (zerop dot-position)))
                       (setf type (subseq name-element (1+ dot-position) end))
                       (setf name (subseq name-element 0 dot-position)))
                      (t (setf name (subseq name-element 0 end))))))))
      (let ((dir (car x)))
        (cond ((or (string= "" dir)
                   (string= "." dir)))
              ((string= ".." dir)
               (push :up directory))
              ((string= "*" dir)
               (push :wild directory))
              ((string= "**" dir)
               (push :wild-inferiors directory))
              (t (push dir directory)))))
    (when (string= name "*") (setf name :wild))
    (when (string= type "*") (setf type :wild))
    (when (string= version "*") (setf version :wild))
    (make-pathname :host host
                   :directory (nreverse directory)
                   :name name
                   :type type
                   :version version)))

(defun unparse-remote-file-path (pathname)
  (when (pathname-device pathname)
    (error 'no-namestring-error
           :pathname pathname
           :format-control "Pathname has a device component"))
  (let ((dir (pathname-directory pathname))
        (name (pathname-name pathname))
        (type (pathname-type pathname))
        (version (pathname-version pathname)))
    (with-output-to-string (s)
      (when (eql dir :wild)
        (setf dir '(:absolute :wild-inferiors)))
      (when (stringp dir)
        (setf dir `(:absolute ,dir)))
      (when (eql dir :unspecific)
        (setf dir nil))
      (when (eql (first dir) :absolute)
        (write-char #\/ s))
      (dolist (d (rest dir))
        (cond
          ((stringp d) (write-string d s))
          ((eql d :up) (write-string ".." s))
          ((eql d :wild) (write-char #\* s))
          ((eql d :wild-inferiors) (write-string "**" s))
          (t
           (error 'no-namestring-error
                  :pathname pathname
                  :format-control "Invalid directory component ~S."
                  :format-arguments (list d))))
        (write-char #\/ s))
      (cond ((eql name :wild)
             (write-char #\* s))
            (name
             (write-string name s)))
      (when (and type
                 (not (eql type :unspecific)))
        (write-char #\. s)
        (if (eql type :wild)
            (write-char #\* s)
            (write-string type s)))
      (case version
        ((nil :newest :wild))
        (:previous
         (write-char #\~ s))
        (t (format s ".~~~D~~" version))))))

(defmethod namestring-using-host ((host remote-file-host) path)
  (unparse-remote-file-path path))

(defmacro with-connection ((var host &key (auto-restart t)) &body body)
  `(call-with-connection ,host (lambda (,var) ,@body) ,auto-restart))

(defun call-with-connection (host fn auto-restart)
  (if *reuse-connection*
      (mezzano.supervisor:with-mutex ((remote-host-lock host) :resignal-errors file-error)
        ;; Inhibit snapshots to prevent the connection from becoming stale
        ;; at a bad time.
        (mezzano.supervisor:with-snapshot-inhibited ()
          (prog ()
           RETRY
             (when (remote-host-connection host)
               ;; Tickle any existing connection to make sure it's still open.
               (handler-case
                   (read-sequence (load-time-value
                                   (make-array 0 :element-type '(unsigned-byte 8)))
                                  (remote-host-connection host))
                 (mezzano.network.tcp:connection-error ()
                   (close (remote-host-connection host) :abort t)
                   (setf (remote-host-connection host) nil))))
             (when (not (remote-host-connection host))
               (setf (remote-host-connection host)
                     (mezzano.network.tcp:tcp-stream-connect
                      (host-address host) (host-port host)
                      :timeout *connection-idle-timeout*)))
             (restart-bind
                 ((retry (lambda ()
                           (when (remote-host-connection host)
                             (close (remote-host-connection host))
                             (setf (remote-host-connection host) nil))
                           (go RETRY))
                    :report-function (lambda (stream)
                                       (format stream "Retry connecting to the file server"))))
               (handler-bind
                   ((error (lambda (c)
                             ;; If an error occurs, then close the current
                             ;; connection and force the next operation to re-open.
                             ;; Just in case the connection gets into a bad state.
                             ;; Due to unwind-protect forms and this being a handler-bind, not a handler-case
                             ;; it is possible for this handler to be recursively reentered along the error
                             ;; path. Avoid closing the connection twice when this happens.
                             (when (remote-host-connection host)
                               (close (remote-host-connection host))
                               (setf (remote-host-connection host) nil))
                             (when (and (typep c 'mezzano.network.tcp:connection-error)<commit_msg>remote: Don't restart connection because of simple-file-error<commit_after>;;;; Copyright (c) 2011-2016 <NAME> <<EMAIL>>
;;;; This code is licensed under the MIT license.

;;; Simple remote file protocol client.

(defpackage :mezzano.file-system.remote
  (:export #:add-remote-file-host
           #:test-host-connectivity)
  (:use #:cl #:mezzano.file-system)
  (:local-nicknames (:gray :mezzano.gray)))

(in-package :mezzano.file-system.remote)

(defvar *reuse-connection* t
  "If true, then the FS will attempt to maintain a single connection to
the server instead of reconnecting for each operation.")
(defvar *connection-idle-timeout* 60
  "Disconnect the reused connection if idle for this long.")
(defvar *default-remote-file-port* 2599)
(defvar *cache-size* (* 512 1024))

(defclass remote-file-host (file-system-host)
  ((%name :initarg :name :reader host-name)
   (%address :initarg :address :reader host-address)
   (%port :initarg :port :reader host-port)
   (%lock :reader remote-host-lock)
   (%connection :initform nil :accessor remote-host-connection))
  (:default-initargs :port *default-remote-file-port*))

(defmethod initialize-instance :after ((instance remote-file-host) &key)
  (setf (slot-value instance '%lock) (mezzano.supervisor:make-mutex `(remote-file-host ,instance))))

(defmethod print-object ((object remote-file-host) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~S ~S:~S"
            (host-name object)
            (host-address object)
            (host-port object))))

(defmethod host-default-device ((host remote-file-host))
  nil)

(defclass remote-file-stream (gray:fundamental-binary-input-stream
                              gray:fundamental-binary-output-stream
                              file-stream)
  ((%path :initarg :path :reader path)
   (%pathname :initarg :pathname :reader file-stream-pathname)
   (%host :initarg :host :reader host)
   (%position :initarg :position :accessor file-position*)
   (%length :initarg :length :accessor file-length*)
   (%direction :initarg :direction :reader direction)
   ;; The buffer.
   (%buffer :initform nil :accessor buffer)
   ;; File position where the buffer data starts.
   (%buffer-position :accessor buffer-position)
   ;; True when the buffer has been written to.
   (%buffer-dirty-p :initform nil :accessor buffer-dirty-p)
   (%abort-action :initarg :abort-action :accessor abort-action))
  (:default-initargs :position 0))

(defclass remote-file-character-stream (gray:fundamental-character-input-stream
                                        gray:fundamental-character-output-stream
                                        mezzano.internals::external-format-mixin
                                        remote-file-stream
                                        gray:unread-char-mixin)
  ())

(defmethod print-object ((object remote-file-stream) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~S ~A"
            (host-name (host object))
            (path object))))

(defun add-remote-file-host (name address &key (port *default-remote-file-port*))
  (setf (find-host name)
        (make-instance 'remote-file-host
                       :name (string-upcase name)
                       :address address
                       :port port)))

(defmethod parse-namestring-using-host ((host remote-file-host) namestring junk-allowed)
  (when junk-allowed
    (error "TODO: Junk-allowed"))
  (let ((start 0)
        (end (length namestring))
        (directory '())
        (name nil)
        (type nil)
        (version nil))
    (when (eql start end)
      (return-from parse-namestring-using-host (make-pathname :host host)))
    (cond ((eql (char namestring start) #\/)
           (push :absolute directory)
           (incf start))
          (t (push :relative directory)))
    ;; Last element is the name.
    (do* ((x (mezzano.internals::explode #\/ namestring start end) (cdr x)))
         ((null (cdr x))
          (let* ((name-element (car x))
                 (end (length name-element)))
            (unless (zerop (length name-element))
              ;; Check for a trailing ~ indicating a backup.
              (when (and (eql (char name-element (1- end)) #\~)
                         (not (eql (length name-element) 1)))
                (decf end)
                (setf version :previous))
              ;; Find the last dot.
              (let ((dot-position (position #\. name-element :from-end t)))
                (cond ((and dot-position (not (zerop dot-position)))
                       (setf type (subseq name-element (1+ dot-position) end))
                       (setf name (subseq name-element 0 dot-position)))
                      (t (setf name (subseq name-element 0 end))))))))
      (let ((dir (car x)))
        (cond ((or (string= "" dir)
                   (string= "." dir)))
              ((string= ".." dir)
               (push :up directory))
              ((string= "*" dir)
               (push :wild directory))
              ((string= "**" dir)
               (push :wild-inferiors directory))
              (t (push dir directory)))))
    (when (string= name "*") (setf name :wild))
    (when (string= type "*") (setf type :wild))
    (when (string= version "*") (setf version :wild))
    (make-pathname :host host
                   :directory (nreverse directory)
                   :name name
                   :type type
                   :version version)))

(defun unparse-remote-file-path (pathname)
  (when (pathname-device pathname)
    (error 'no-namestring-error
           :pathname pathname
           :format-control "Pathname has a device component"))
  (let ((dir (pathname-directory pathname))
        (name (pathname-name pathname))
        (type (pathname-type pathname))
        (version (pathname-version pathname)))
    (with-output-to-string (s)
      (when (eql dir :wild)
        (setf dir '(:absolute :wild-inferiors)))
      (when (stringp dir)
        (setf dir `(:absolute ,dir)))
      (when (eql dir :unspecific)
        (setf dir nil))
      (when (eql (first dir) :absolute)
        (write-char #\/ s))
      (dolist (d (rest dir))
        (cond
          ((stringp d) (write-string d s))
          ((eql d :up) (write-string ".." s))
          ((eql d :wild) (write-char #\* s))
          ((eql d :wild-inferiors) (write-string "**" s))
          (t
           (error 'no-namestring-error
                  :pathname pathname
                  :format-control "Invalid directory component ~S."
                  :format-arguments (list d))))
        (write-char #\/ s))
      (cond ((eql name :wild)
             (write-char #\* s))
            (name
             (write-string name s)))
      (when (and type
                 (not (eql type :unspecific)))
        (write-char #\. s)
        (if (eql type :wild)
            (write-char #\* s)
            (write-string type s)))
      (case version
        ((nil :newest :wild))
        (:previous
         (write-char #\~ s))
        (t (format s ".~~~D~~" version))))))

(defmethod namestring-using-host ((host remote-file-host) path)
  (unparse-remote-file-path path))

(defmacro with-connection ((var host &key (auto-restart t)) &body body)
  `(call-with-connection ,host (lambda (,var) ,@body) ,auto-restart))

(defun call-with-connection (host fn auto-restart)
  (if *reuse-connection*
      (mezzano.supervisor:with-mutex ((remote-host-lock host) :resignal-errors file-error)
        ;; Inhibit snapshots to prevent the connection from becoming stale
        ;; at a bad time.
        (mezzano.supervisor:with-snapshot-inhibited ()
          (prog ()
           RETRY
             (when (remote-host-connection host)
               ;; Tickle any existing connection to make sure it's still open.
               (handler-case
                   (read-sequence (load-time-value
                                   (make-array 0 :element-type '(unsigned-byte 8)))
                                  (remote-host-connection host))
                 (mezzano.network.tcp:connection-error ()
                   (close (remote-host-connection host) :abort t)
                   (setf (remote-host-connection host) nil))))
             (when (not (remote-host-connection host))
               (setf (remote-host-connection host)
                     (mezzano.network.tcp:tcp-stream-connect
                      (host-address host) (host-port host)
                      :timeout *connection-idle-timeout*)))
             (restart-bind
                 ((retry (lambda ()
                           (when (remote-host-connection host)
                             (close (remote-host-connection host))
                             (setf (remote-host-connection host) nil))
                           (go RETRY))
                         :report-function (lambda (stream)
                                            (format stream "Retry connecting to the file server"))))
               (handler-bind
                   ((simple-file-error (lambda (c)
                                         (return c)))
                    (error (lambda (c)
                             ;; If an error occurs, then close the current
                             ;; connection and force the next operation to re-open.
                             ;; Just in case the connection gets into a bad state.
                             ;; Due to unwind-protect forms and this being a handler-bind, not a handler-case
                             ;; it is possible for this handler to be recursively reentered along the error
                             ;; path. Avoid closing the connection twice when this happens.
                             (when (remote-host-connection host)
                               (close (remote-host-connection host))
                               (setf (remote-host-connection host) nil))
                             (when (and (typep c 'mezzano.network.tcp:connection-error)
{'fraction_non_alphanumeric': 0.12607622979708977, 'fraction_numerical': 0.0030209959216555057, 'mean_word_length': 1.8451511244807335, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 19, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3899359', 'n_tokens_mistral': 5654, 'n_tokens_neox': 5411, 'n_words': 1610}