Created structure ips for ip-string related procedures.
This commit is contained in:
parent
0e7152b68b
commit
45223c1d81
|
@ -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,40 +286,10 @@
|
|||
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)
|
||||
|
@ -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 name)))
|
||||
(ip-string->in-addr.arpa-string (address32->ip-string 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 name)))
|
||||
(ip-string->in-addr.arpa-string (address32->ip-string 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 ip)))
|
||||
(ip-string->in-addr.arpa-string (address32->ip-string 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 name)))
|
||||
(ip-string->in-addr.arpa-string (address32->ip-string 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 name)))
|
||||
(ip-string->in-addr.arpa-string (address32->ip-string 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)
|
||||
|
|
|
@ -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)))
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue