<commit_before>;;; -*- Gerbil -*-
;;; (C) vyzo
;;; actor rpc null protocol
package: std/actor/proto

(import :gerbil/gambit/ports
        :std/net/address
        :std/actor/proto
        :std/actor/proto/message
        )

(export rpc-proto-accept-e
        rpc-proto-connect-e
        rpc-null-proto
        rpc-null-proto-open-client
        rpc-null-proto-open-server
        rpc-null-proto-read
        rpc-null-proto-write)

;; generic rpc hello
(def (rpc-proto-accept-e sock proto-t K)
  (def (connection-closed . args)
    (apply raise-rpc-error 'rpc-proto-accept "connection closed" args))
  (def (bad-hello . args)
    (apply raise-rpc-error 'rpc-proto-accept "bad hello" args))
  
  (let (e (read-u8 sock))
    (cond
     ((eof-object? e)
      (connection-closed sock))
     ((eq? e rpc-proto-connect-hello)
      (let (e (read-u8 sock))
        (cond
         ((eof-object? e)
          (connection-closed sock))
         ((eq? e proto-t)
          (write-u8/force-output rpc-proto-connect-accept sock)
          (K sock))
         (else
          (write-u8/force-output rpc-proto-connect-reject sock)
          (bad-hello e sock)))))
     (else
      (bad-hello e sock)))))

(def (rpc-proto-connect-e sock proto-t K)
  (def (connection-closed . args)
    (apply raise-rpc-error 'rpc-proto-connect "connection closed" args))
  (def (bad-hello . args)
    (apply raise-rpc-error 'rpc-proto-connect "bad hello" args))

  (write-u8 rpc-proto-connect-hello sock)
  (write-u8 proto-t sock)
  (force-output sock)
  (let (e (read-u8 sock))
    (cond
     ((eof-object? e)
      (connection-closed sock))
     ((eq? e rpc-proto-connect-accept)
      (K sock))
     (else
      (bad-hello e sock)))))

;;; NULL proto; unathenticated clear text.
(def (rpc-null-proto-open-client inaddr)
  (open-tcp-client (inet-address->string inaddr)))

(def (rpc-null-proto-open-server inaddr)
  (open-tcp-server (inet-address->string inaddr)))

(def (rpc-null-proto-accept sock)
  (rpc-proto-accept-e sock rpc-proto-null
    (lambda (sock)
      (values rpc-null-proto-read
              rpc-null-proto-write))))

(def (rpc-null-proto-connect sock)<commit_msg>std/actor: raise specific error when the connect hello is rejected<commit_after>;;; -*- Gerbil -*-
;;; (C) vyzo
;;; actor rpc null protocol
package: std/actor/proto

(import :gerbil/gambit/ports
        :std/net/address
        :std/actor/proto
        :std/actor/proto/message
        )

(export rpc-proto-accept-e
        rpc-proto-connect-e
        rpc-null-proto
        rpc-null-proto-open-client
        rpc-null-proto-open-server
        rpc-null-proto-read
        rpc-null-proto-write)

;; generic rpc hello
(def (rpc-proto-accept-e sock proto-t K)
  (def (connection-closed . args)
    (apply raise-rpc-error 'rpc-proto-accept "connection closed" args))
  (def (bad-hello . args)
    (apply raise-rpc-error 'rpc-proto-accept "bad hello" args))
  
  (let (e (read-u8 sock))
    (cond
     ((eof-object? e)
      (connection-closed sock))
     ((eq? e rpc-proto-connect-hello)
      (let (e (read-u8 sock))
        (cond
         ((eof-object? e)
          (connection-closed sock))
         ((eq? e proto-t)
          (write-u8/force-output rpc-proto-connect-accept sock)
          (K sock))
         (else
          (write-u8/force-output rpc-proto-connect-reject sock)
          (bad-hello e sock)))))
     (else
      (bad-hello e sock)))))

(def (rpc-proto-connect-e sock proto-t K)
  (def (connection-rejected sock)
    (raise-rpc-error 'rpc-proto-connect "Connection hello rejected by peer" sock))
  (def (connection-closed . args)
    (apply raise-rpc-error 'rpc-proto-connect "connection closed" args))
  (def (bad-hello . args)
    (apply raise-rpc-error 'rpc-proto-connect "bad hello" args))

  (write-u8 rpc-proto-connect-hello sock)
  (write-u8 proto-t sock)
  (force-output sock)
  (let (e (read-u8 sock))
    (cond
     ((eof-object? e)
      (connection-closed sock))
     ((eq? e rpc-proto-connect-accept)
      (K sock))
     ((eq? e rpc-proto-connect-reject)
      (connection-rejected sock))
     (else
      (bad-hello e sock)))))

;;; NULL proto; unathenticated clear text.
(def (rpc-null-proto-open-client inaddr)
  (open-tcp-client (inet-address->string inaddr)))

(def (rpc-null-proto-open-server inaddr)
  (open-tcp-server (inet-address->string inaddr)))

(def (rpc-null-proto-accept sock)
  (rpc-proto-accept-e sock rpc-proto-null
    (lambda (sock)
      (values rpc-null-proto-read
              rpc-null-proto-write))))

(def (rpc-null-proto-connect sock)
{'fraction_non_alphanumeric': 0.15342284833810257, 'fraction_numerical': 0.0030816640986132513, 'mean_word_length': 2.434618291761149, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '746541', 'n_tokens_mistral': 1601, 'n_tokens_neox': 1577, 'n_words': 362}