Created structure ips for ip-string related procedures.

scheme/lib/dns.scm

@@ -274,61 +274,8 @@
 (define (add-size-tag m)
   (append (number->octet-pair (length m)) m))
 
-;; converts an octeted-ip to a 32bit integer internet-address
-(define (octet-ip->address32 ip)
-  (+ (arithmetic-shift (char->ascii (list-ref ip 0)) 24)
-     (arithmetic-shift (char->ascii (list-ref ip 1)) 16)
-     (arithmetic-shift (char->ascii (list-ref ip 2)) 8)
-     (char->ascii (list-ref ip 3))))
 
-;; converts a 32 bit integer internet-address to an octeted-ip
-(define (address32->octet-ip ip)
-  (list (arithmetic-shift ip -24)
-	(modulo (arithmetic-shift ip -16) 256)
-	(modulo (arithmetic-shift ip -8) 256)
-	(modulo ip 256)))
 
-;; converts an ip-string to an 32bit integer internet-address
-(define (ip-string->address32 ip)
-  (octet-ip->address32 (ip-string->octet-ip ip)))
-
-;; converts an ip-string to an 32bit integer internet-address
-(define (address32->ip-string ip)
-  (format #f
-	  "~a.~a.~a.~a" 
-	  (arithmetic-shift ip -24)
-	  (modulo (arithmetic-shift ip -16) 256)
-	  (modulo (arithmetic-shift ip -8) 256)
-	  (modulo ip 256)))
-
-;; converts an octeted-ip to an human readable ip-string
-(define (octet-ip->ip-string s)
-  (format #f
-	  "~a.~a.~a.~a" 
-	  (char->ascii (list-ref s 0))
-	  (char->ascii (list-ref s 1))
-	  (char->ascii (list-ref s 2))
-	  (char->ascii (list-ref s 3))))
-
-(define ip-string-regexp (rx (: bos 
-			  (submatch (** 1 3 digit)) "." 
-			  (submatch (** 1 3 digit)) "." 
-			  (submatch (** 1 3 digit)) "." 
-			  (submatch (** 1 3 digit)) 
-			  eos)))
-
-;; converts an ip-string to octets
-(define (ip-string->octet-ip s)
-  (cond
-   ((regexp-search ip-string-regexp  s)
-    => (lambda (match)
-	 (list
-	  (ascii->char (string->number (match:substring match 1)))
-	  (ascii->char (string->number (match:substring match 2)))
-	  (ascii->char (string->number (match:substring match 3)))
-	  (ascii->char (string->number (match:substring match 4))))))
-   (else
-    (error "invalid ip-string" s))))
 
 ;; calculates a "random" number, needed for message-ids
 ;; TODO use SRFI-27
@@ -339,41 +286,11 @@
 		   limit)
 		314159265))))
 
-;; checks if a string is a ip
-(define (ip-string? s)
-  (define (byte-as-string? string) 
-    (let ((number (string->number string)))
-      (and number
-	   (>= number 0)
-	   (< number 256))))
-  (cond
-   ((regexp-search ip-string-regexp  s)
-    => (lambda (match)
-	 (and (byte-as-string? (match:substring match 1))
-	      (byte-as-string? (match:substring match 2))
-	      (byte-as-string? (match:substring match 3))
-	      (byte-as-string? (match:substring match 4)))))
-   (else #f)))
-
-    
 ;; checks if v is a address32
 (define (address32? v)
   (and (number? v)
        (<= 0 v #xffffffff)))
       
-;; returns a in-addr.arpa name-string or #f (needed to resolve hostname by ip)
-(define (ip-string->in-addr-arpa s)
-  (cond
-   ((regexp-search ip-string-regexp s)
-    => (lambda (match)
-	 (string-append
-	  (match:substring match 4) "."
-	  (match:substring match 3) "."
-	  (match:substring match 2) "."
-	  (match:substring match 1) "."
-	  "in-addr.arpa")))
-   (else #f)))
-      
 ;; filters types in a list of rrs 
 (define (filter-type list type)
   (filter (lambda (rr) 
@@ -1275,8 +1192,8 @@
 (define (dns-lookup name type . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let* ((maybe-ip-string (if (address32? name) 
-				(ip-string->in-addr-arpa (address32->ip-string name))
+				(ip-string->in-addr.arpa-string (address32->ip-string name))
-				(ip-string->in-addr-arpa name)))
+				(ip-string->in-addr.arpa-string name)))
 	   (query (if maybe-ip-string	; if name is a ip-addr, the query is a in-addr.arpa address
 		      (make-simple-query-message
 		       maybe-ip-string type (message-class in))
@@ -1293,8 +1210,8 @@
 (define (dns-lookup-name name . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let* ((maybe-ip-string (if (address32? name) 
-				(ip-string->in-addr-arpa (address32->ip-string name))
+				(ip-string->in-addr.arpa-string (address32->ip-string name))
-				(ip-string->in-addr-arpa name)))
+				(ip-string->in-addr.arpa-string name)))
 	   (query (if maybe-ip-string	; if name is a ip-addr, the query is a in-addr.arpa address
 		      (dns-error 'not-a-hostname)
 		      (make-simple-query-message name (message-type a) (message-class in))))
@@ -1312,8 +1229,8 @@
 (define (dns-lookup-ip ip . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let* ((maybe-ip-string (if (address32? ip) 
-				(ip-string->in-addr-arpa (address32->ip-string ip))
+				(ip-string->in-addr.arpa-string (address32->ip-string ip))
-				(ip-string->in-addr-arpa ip)))
+				(ip-string->in-addr.arpa-string ip)))
 	   (query (if maybe-ip-string	; if name is a ip-addr, the query is a in-addr.arpa address
 		      (make-simple-query-message maybe-ip-string (message-type ptr) (message-class in))
 		      (dns-error 'not-a-ip)))
@@ -1334,8 +1251,8 @@
 (define (dns-lookup-nameserver name . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let* ((maybe-ip-string (if (address32? name) 
-				(ip-string->in-addr-arpa (address32->ip-string name))
+				(ip-string->in-addr.arpa-string (address32->ip-string name))
-				(ip-string->in-addr-arpa name)))
+				(ip-string->in-addr.arpa-string name)))
 	   (query (if maybe-ip-string	; if name is a ip-addr, the query is a in-addr.arpa address
 		      (dns-error 'not-a-hostname)
 		      (make-simple-query-message
@@ -1364,8 +1281,8 @@
 (define (dns-lookup-mail-exchanger name . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let* ((ip-string (if (address32? name) 
-			  (ip-string->in-addr-arpa (address32->ip-string name))
+			  (ip-string->in-addr.arpa-string (address32->ip-string name))
-			  (ip-string->in-addr-arpa name)))
+			  (ip-string->in-addr.arpa-string name)))
 	   (query (if ip-string		; if name is a ip-addr, the query is a in-addr.arpa address
 		      (dns-error 'not-a-hostname)
 		      (make-simple-query-message
@@ -1543,7 +1460,7 @@
   (if (socket-address? name-or-socket-address)
       (apply socket-address->fqdn name-or-socket-address args)
       (let ((name name-or-socket-address))
-	(if (is-fqdn? name)
+	(if (fqdn? name)
 	    name
 	    (let lp ((domains (domains-for-search)))
 	      (if (null? domains)

scheme/lib/ip.scm

@@ -0,0 +1,80 @@
+;; converts an ip-string to an 32bit integer internet-address
+(define (address32->ip-string ip)
+  (octet-ip->ip-string (address32->octet-ip ip)))
+  
+;; converts an ip-string to an 32bit integer internet-address
+(define (ip-string->address32 ip)
+  (octet-ip->address32 (ip-string->octet-ip ip)))
+
+;; checks if a string is a ip
+(define (ip-string? s)
+  (define (byte-as-string? string) 
+    (let ((number (string->number string)))
+      (and number
+	   (>= number 0)
+	   (< number 256))))
+  (cond
+   ((regexp-search ip-string-regexp  s)
+    => (lambda (match)
+	 (and (byte-as-string? (match:substring match 1))
+	      (byte-as-string? (match:substring match 2))
+	      (byte-as-string? (match:substring match 3))
+	      (byte-as-string? (match:substring match 4)))))
+   (else #f)))
+
+;; converts an ip-string to octets
+(define (ip-string->octet-ip s)
+  (cond
+   ((regexp-search ip-string-regexp  s)
+    => (lambda (match)
+	 (list
+	  (ascii->char (string->number (match:substring match 1)))
+	  (ascii->char (string->number (match:substring match 2)))
+	  (ascii->char (string->number (match:substring match 3)))
+	  (ascii->char (string->number (match:substring match 4))))))
+   (else
+    (error "invalid ip-string" s))))
+
+;; converts an octeted-ip to a 32bit integer internet-address
+(define (octet-ip->address32 ip)
+  (+ (arithmetic-shift (char->ascii (list-ref ip 0)) 24)
+     (arithmetic-shift (char->ascii (list-ref ip 1)) 16)
+     (arithmetic-shift (char->ascii (list-ref ip 2)) 8)
+     (char->ascii (list-ref ip 3))))
+
+;; converts a 32 bit integer internet-address to an octeted-ip
+(define (address32->octet-ip ip)
+  (list (ascii->char (arithmetic-shift ip -24))
+	(ascii->char (modulo (arithmetic-shift ip -16) 256))
+	(ascii->char (modulo (arithmetic-shift ip -8) 256))
+	(ascii->char (modulo ip 256))))
+
+
+;; converts an octeted-ip to an human readable ip-string
+(define (octet-ip->ip-string s)
+  (format #f
+	  "~a.~a.~a.~a" 
+	  (char->ascii (list-ref s 0))
+	  (char->ascii (list-ref s 1))
+	  (char->ascii (list-ref s 2))
+	  (char->ascii (list-ref s 3))))
+
+;; returns a in-addr.arpa name-string or #f (needed to resolve hostname by ip)
+(define (ip-string->in-addr.arpa-string s)
+  (cond
+   ((regexp-search ip-string-regexp s)
+    => (lambda (match)
+	 (string-append
+	  (match:substring match 4) "."
+	  (match:substring match 3) "."
+	  (match:substring match 2) "."
+	  (match:substring match 1) "."
+	  "in-addr.arpa")))
+   (else #f)))
+
+(define ip-string-regexp (rx (: bos 
+			  (submatch (** 1 3 digit)) "." 
+			  (submatch (** 1 3 digit)) "." 
+			  (submatch (** 1 3 digit)) "." 
+			  (submatch (** 1 3 digit)) 
+			  eos)))

scheme/packages.scm

@@ -159,6 +159,13 @@
 	  host-fqdn
 	  system-fqdn))
 
+(define-interface ips-interface
+  (export address32->ip-string
+	  ip-string->address32
+	  ip-string->in-addr.arpa-string
+	  octet-ip->address32 ;for dns.scm
+	  ip-string?))
+
 (define-interface cgi-scripts-interface
   (export cgi-form-query))
 
@@ -479,9 +486,15 @@
 	handle
 	sort
 	threads
-	locks)
+	locks
+	ips)
   (files (lib dns)))
 
+(define-structure ips ips-interface
+  (open scheme-with-scsh
+	formats)
+  (files (lib ip)))
+
 (define-structure cgi-scripts cgi-scripts-interface
   (open scheme-with-scsh
 	parse-html-forms)