<commit_before>;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-

;;   Copyright (C) 2006, 2007 <NAME>
;;
;;   This code is free software; you can redistribute it and/or
;;   modify it under the terms of the version 2.1 of
;;   the GNU Lesser General Public License as published by
;;   the Free Software Foundation, as clarified by the
;;   preamble found here:
;;       http://opensource.franz.com/preamble.html
;;
;;   This program is distributed in the hope that it will be useful,
;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;   GNU General Public License for more details.
;;
;;   You should have received a copy of the GNU Lesser General
;;   Public License along with this library; if not, write to the
;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;;   Boston, MA 02110-1301, USA

(in-package :net.sockets)

;;;;;;;;;;;;;
;;;       ;;;
;;; Types ;;;
;;;       ;;;
;;;;;;;;;;;;;

(deftype ipv4-array ()
  '(ub8-sarray 4))
(deftype ipv6-array ()
  '(ub16-sarray 8))



(define-modify-macro coercef (type-spec) coerce)


;;;
;;; Byte-swap functions
;;;

(defun htons (short)
  (check-type short ub16 "a 16-bit unsigned number")
  #+little-endian
  (logior (ash (logand (the ub16 short) #x00FF) 8)
          (ash (logand (the ub16 short) #xFF00) -8))
  #+big-endian short)

(defun ntohs (short)
  (htons short))

(defun htonl (long)
  (check-type long ub32 "a 32-bit unsigned number")
  #+little-endian
  (logior (ash (logand (the ub32 long) #x000000FF) 24)
          (ash (logand (the ub32 long) #x0000FF00) 8)
          (ash (logand (the ub32 long) #x00FF0000) -8)
          (ash (logand (the ub32 long) #xFF000000) -24))
  #+big-endian long)

(defun ntohl (long)
  (htonl long))


;;;
;;; Conversion between address formats
;;;

(defun copy-simple-array-ub16-to-alien-vector (lisp-vec alien-vec)
  (declare (type ipv6-array lisp-vec))
  (dotimes (i 8)
    (setf (mem-aref alien-vec :uint16 i)
          (htons (aref lisp-vec i)))))

(defun map-ipv4-vector-to-ipv6 (addr)
  (declare (type ipv4-array addr))
  (let ((ipv6addr (make-array 8 :element-type 'ub16
                                :initial-element 0)))
    ;; setting the IPv4 marker
    (setf (aref ipv6addr 5) #xFFFF)
    ;; setting the first two bytes
    (setf (aref ipv6addr 6) (+ (ash (aref addr 0) 8)
                               (aref addr 1)))
    ;; setting the last two bytes
    (setf (aref ipv6addr 7) (+ (ash (aref addr 2) 8)
                               (aref addr 3)))

    ipv6addr))

;; From CLOCC's PORT library
(defun vector-to-ipaddr (vector)
  "Convert a vector to a 32-bit unsigned integer."
  (coercef vector 'ipv4-array)
  (+ (ash (aref vector 0) 24)
     (ash (aref vector 1) 16)
     (ash (aref vector 2) 8)
     (aref vector 3)))

(defun ipaddr-to-vector (ipaddr)
  "Convert a 32-bit unsigned integer to a vector."
  (check-type ipaddr ub32)
  (let ((vector (make-array 4 :element-type 'ub8)))
    (setf (aref vector 0) (ldb (byte 8 24) ipaddr)
          (aref vector 1) (ldb (byte 8 16) ipaddr)
          (aref vector 2) (ldb (byte 8  8) ipaddr)
          (aref vector 3) (ldb (byte 8  0) ipaddr))
    vector))

(defun in6-addr-to-ipv6-array (in6-addr)
  (let ((vector (make-array 8 :element-type 'ub16)))
    (dotimes (i 8)
      (setf (aref vector i)
            (ntohs (mem-aref in6-addr :uint16 i))))
    vector))


;;;
;;; Constructors for SOCKADDR_* structs
;;;

(defun make-sockaddr-in (sin ub8-vector &optional (port 0))
  (et:bzero sin et:size-of-sockaddr-in)
  (let ((tmp port))
    (with-foreign-slots ((et:family et:addr et:port) sin et:sockaddr-in)
      (setf et:family et:af-inet)
      (setf et:addr (htonl (vector-to-ipaddr ub8-vector)))
      (setf et:port (htons tmp))))
  sin)

(defun make-sockaddr-in6 (sin6 ub16-vector &optional (port 0))
  (et:bzero sin6 et:size-of-sockaddr-in6)
  (let ((tmp port))
    (with-foreign-slots ((et:family et:addr et:port) sin6 et:sockaddr-in6)
      (setf et:family et:af-inet6)
      (copy-simple-array-ub16-to-alien-vector ub16-vector et:addr)
      (setf et:port (htons tmp))))
  sin6)

(defun make-sockaddr-un (sun string)
  (check-type string string)
  (et:bzero sun et:size-of-sockaddr-un)
  (with-foreign-slots ((et:family et:path) sun et:sockaddr-un)
    (setf et:family et:af-local)
    (with-foreign-string (c-string string)
      (loop
         :for off :below (1- et:unix-path-max)
         :do (setf (mem-aref et:path :uint8 off)
                   (mem-aref c-string :uint8 off)))))
  sun)


;;;
;;; Conversion functions for SOCKADDR_* structs
;;;

(defun sockaddr-in->sockaddr (sin)
  (with-foreign-slots ((et:addr et:port) sin et:sockaddr-in)
    (values (make-instance 'ipv4addr
                           :name (ipaddr-to-vector (ntohl et:addr)))
            (ntohs et:port))))<commit_msg>Added type declarations to sockaddr_* constructors. Signed-off-by: <NAME> <<EMAIL>><commit_after>;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-

;;   Copyright (C) 2006, 2007 <NAME>
;;
;;   This code is free software; you can redistribute it and/or
;;   modify it under the terms of the version 2.1 of
;;   the GNU Lesser General Public License as published by
;;   the Free Software Foundation, as clarified by the
;;   preamble found here:
;;       http://opensource.franz.com/preamble.html
;;
;;   This program is distributed in the hope that it will be useful,
;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;   GNU General Public License for more details.
;;
;;   You should have received a copy of the GNU Lesser General
;;   Public License along with this library; if not, write to the
;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;;   Boston, MA 02110-1301, USA

(in-package :net.sockets)

;;;;;;;;;;;;;
;;;       ;;;
;;; Types ;;;
;;;       ;;;
;;;;;;;;;;;;;

(deftype ipv4-array ()
  '(ub8-sarray 4))
(deftype ipv6-array ()
  '(ub16-sarray 8))



(define-modify-macro coercef (type-spec) coerce)


;;;
;;; Byte-swap functions
;;;

(defun htons (short)
  (check-type short ub16 "a 16-bit unsigned number")
  #+little-endian
  (logior (ash (logand (the ub16 short) #x00FF) 8)
          (ash (logand (the ub16 short) #xFF00) -8))
  #+big-endian short)

(defun ntohs (short)
  (htons short))

(defun htonl (long)
  (check-type long ub32 "a 32-bit unsigned number")
  #+little-endian
  (logior (ash (logand (the ub32 long) #x000000FF) 24)
          (ash (logand (the ub32 long) #x0000FF00) 8)
          (ash (logand (the ub32 long) #x00FF0000) -8)
          (ash (logand (the ub32 long) #xFF000000) -24))
  #+big-endian long)

(defun ntohl (long)
  (htonl long))


;;;
;;; Conversion between address formats
;;;

(defun copy-simple-array-ub16-to-alien-vector (lisp-vec alien-vec)
  (declare (type ipv6-array lisp-vec))
  (dotimes (i 8)
    (setf (mem-aref alien-vec :uint16 i)
          (htons (aref lisp-vec i)))))

(defun map-ipv4-vector-to-ipv6 (addr)
  (declare (type ipv4-array addr))
  (let ((ipv6addr (make-array 8 :element-type 'ub16
                                :initial-element 0)))
    ;; setting the IPv4 marker
    (setf (aref ipv6addr 5) #xFFFF)
    ;; setting the first two bytes
    (setf (aref ipv6addr 6) (+ (ash (aref addr 0) 8)
                               (aref addr 1)))
    ;; setting the last two bytes
    (setf (aref ipv6addr 7) (+ (ash (aref addr 2) 8)
                               (aref addr 3)))

    ipv6addr))

;; From CLOCC's PORT library
(defun vector-to-ipaddr (vector)
  "Convert a vector to a 32-bit unsigned integer."
  (coercef vector 'ipv4-array)
  (+ (ash (aref vector 0) 24)
     (ash (aref vector 1) 16)
     (ash (aref vector 2) 8)
     (aref vector 3)))

(defun ipaddr-to-vector (ipaddr)
  "Convert a 32-bit unsigned integer to a vector."
  (check-type ipaddr ub32)
  (let ((vector (make-array 4 :element-type 'ub8)))
    (setf (aref vector 0) (ldb (byte 8 24) ipaddr)
          (aref vector 1) (ldb (byte 8 16) ipaddr)
          (aref vector 2) (ldb (byte 8  8) ipaddr)
          (aref vector 3) (ldb (byte 8  0) ipaddr))
    vector))

(defun in6-addr-to-ipv6-array (in6-addr)
  (let ((vector (make-array 8 :element-type 'ub16)))
    (dotimes (i 8)
      (setf (aref vector i)
            (ntohs (mem-aref in6-addr :uint16 i))))
    vector))


;;;
;;; Constructors for SOCKADDR_* structs
;;;

(defun make-sockaddr-in (sin ub8-vector &optional (port 0))
  (declare (type ipv4-array ub8-vector)
           (type ub16 port))
  (et:bzero sin et:size-of-sockaddr-in)
  (with-foreign-slots ((et:family et:addr et:port) sin et:sockaddr-in)
    (setf et:family et:af-inet)
    (setf et:addr (htonl (vector-to-ipaddr ub8-vector)))
    (setf et:port (htons port)))
  sin)

(defun make-sockaddr-in6 (sin6 ub16-vector &optional (port 0))
  (declare (type ipv6-array ub16-vector)
           (type ub16 port))
  (et:bzero sin6 et:size-of-sockaddr-in6)
  (with-foreign-slots ((et:family et:addr et:port) sin6 et:sockaddr-in6)
    (setf et:family et:af-inet6)
    (copy-simple-array-ub16-to-alien-vector ub16-vector et:addr)
    (setf et:port (htons port)))
  sin6)

(defun make-sockaddr-un (sun string)
  (declare (type string string))
  (et:bzero sun et:size-of-sockaddr-un)
  (with-foreign-slots ((et:family et:path) sun et:sockaddr-un)
    (setf et:family et:af-local)
    (with-foreign-string (c-string string)
      (loop
         :for off :below (1- et:unix-path-max)
         :do (setf (mem-aref et:path :uint8 off)
                   (mem-aref c-string :uint8 off)))))
  sun)


;;;
;;; Conversion functions for SOCKADDR_* structs
;;;

(defun sockaddr-in->sockaddr (sin)
  (with-foreign-slots ((et:addr et:port) sin et:sockaddr-in)
    (values (make-instance 'ipv4addr
                           :name (ipaddr-to-vector (ntohl et:addr)))
            (ntohs et:port))))
{'fraction_non_alphanumeric': 0.14688352358824125, 'fraction_numerical': 0.036468330134357005, 'mean_word_length': 2.861154446177847, 'pattern_counts': {'":': 0, '<': 8, '<?xml version=': 0, '>': 10, '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': '6158432', 'n_tokens_mistral': 3905, 'n_tokens_neox': 3615, 'n_words': 1100}