;;; socks-tests.el --- tests for SOCKS -*- coding: utf-8; lexical-binding: t; -*-

;;; Commentary:

;; This file is supposed to describe (what's believed to be) an existing bug.
;;
;; | (let ((default-directory (expand-file-name "../..")))
;; |   (compile "make lisp/net/socks-tests.log"))

(require 'socks)

(ert-deftest socks-filter-test-existing-behavior-v4 ()
  (let* ((buf (generate-new-buffer "*test-socks-filter*"))
         (proc (start-process "test-socks-filter" buf "sleep" "1")))
    (process-put proc 'socks t)
    (process-put proc 'socks-state socks-state-waiting)
    (process-put proc 'socks-server-protocol 4)
    (ert-info ("Receive initial incomplete segment")
      (should (equal (string-to-vector "\0Z\0\0]¸Ø") [0 90 0 0 93 184 216]))
      ;; An IPv4 address from example.com     OK status ^      ^ msg start
      (socks-filter proc "\0Z\0\0]¸Ø")
      (ert-info ("State still set to waiting")
        (should (eq (process-get proc 'socks-state) socks-state-waiting)))
      (ert-info ("Response field is nil because processing incomplete")
        (should-not (process-get proc 'socks-response)))
      (ert-info ("Scratch field holds stashed partial payload")
        (should (string= "\0Z\0\0]¸Ø" (process-get proc 'socks-scratch)))))
    (ert-info ("Last part arrives")
      (socks-filter proc "\42") ; ?\" 34
      (ert-info ("State transitions to complete (proto length check passes)")
        (should (eq (process-get proc 'socks-state) socks-state-connected)))
      (ert-info ("Response field holds last scratch with new segment appended")
        (should (string= "\0Z\0\0]¸Ø\"" (process-get proc 'socks-response))))
      (ert-info ("Scratch remains populated, matches response field")
        (should (string= "\0Z\0\0]¸Ø\"" (process-get proc 'socks-scratch)))))
    (should (equal (string-to-vector "\0Z\0\0]¸Ø\"") [0 90 0 0 93 184 216 34]))
    (delete-process proc)
    (set-process-query-on-exit-flag proc nil)
    (kill-buffer buf)))

(ert-deftest socks-filter-test-existing-behavior-v5 ()
  (let* ((buf (generate-new-buffer "*test-socks-filter*"))
         (proc (start-process "test-socks-filter" buf "sleep" "1")))
    (process-put proc 'socks t)
    (process-put proc 'socks-state socks-state-waiting)
    (process-put proc 'socks-server-protocol 5)
    (ert-info ("Receive initial incomplete segment")
      ;; An Ipv6 addr for fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
      (should (equal (string-to-vector (concat
                                        "\5\0\0\4"
                                        "\x26\x05\xbc\x80\x30\x10\x00\x60"
                                        "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
                                        "\0\0"))
                     (vconcat
                      [5 0 0 4] ; version status (OK) noop addr-type (4 -> 6!)
                      [#x26 #x05 #xbc #x80 #x30 #x10 #x00 #x60]
                      [#xde #xad #xbe #xef #xca #xfe #xfe #xd9]
                      [0 0])))
      (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
      (ert-info ("State still set to waiting")
        (should (eq (process-get proc 'socks-state) socks-state-waiting)))
      (ert-info ("Response field is nil because processing incomplete")
        (should-not (process-get proc 'socks-response)))
      (ert-info ("Scratch field holds partial payload of pending msg")
        (should (string= "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60"
                         (process-get proc 'socks-scratch)))))
    (ert-info ("Second part arrives")
      (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
      (ert-info ("State untouched")
        (should (eq (process-get proc 'socks-state) socks-state-waiting)))
      (ert-info ("Response field untouched")
        (should-not (process-get proc 'socks-response)))
      (ert-info ("Scratch contains new arrival appended")
        (should (string=  (concat "\5\0\0\4"
                                  "\x26\x05\xbc\x80\x30\x10\x00\x60"
                                  "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
                          (process-get proc 'socks-scratch)))))
    (ert-info ("Final part arrives (port number)")
      (socks-filter proc "\0\0")
      (ert-info ("State transitions to complete")
        (should (eq (process-get proc 'socks-state) socks-state-connected)))
      (ert-info ("Scratch contains final part appended")
        (should (string=  (concat "\5\0\0\4"
                                  "\x26\x05\xbc\x80\x30\x10\x00\x60"
                                  "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
                                  "\0\0")
                          (process-get proc 'socks-scratch))))
      (ert-info ("Response field updated with final message")
        (should (string= (process-get proc 'socks-response)
                         (process-get proc 'socks-scratch)))))
    (delete-process proc)
    (set-process-query-on-exit-flag proc nil)
    (kill-buffer buf)))


;;; socks-tests.el ends here