[Gd-chatter] r11161 - trunk/fundev/sources/network/sockets

hannes at gwydiondylan.org hannes at gwydiondylan.org
Sat Feb 3 00:25:00 CET 2007


Author: hannes
Date: Sat Feb  3 00:24:59 2007
New Revision: 11161

Modified:
   trunk/fundev/sources/network/sockets/unix-socket-accessor.dylan
Log:
Job: fd
implement lock for resolver. gethostbyaddr, etc. are not thread safe.
getaddrinfo should be used (which is thread safe and doesn't need a lock)


Modified: trunk/fundev/sources/network/sockets/unix-socket-accessor.dylan
==============================================================================
--- trunk/fundev/sources/network/sockets/unix-socket-accessor.dylan	(original)
+++ trunk/fundev/sources/network/sockets/unix-socket-accessor.dylan	Sat Feb  3 00:24:59 2007
@@ -20,9 +20,6 @@
          end }
 end macro;
 
-// TODO: Real errno accessor
-// define method unix-errno () 99 end;
-
 define constant <LPLINGER> = <linger*>;
 define constant <LPHOSTENT> = <hostent*>;
 define constant <LPSERVENT> = <servent*>;
@@ -237,6 +234,8 @@
 // 
 // TODO: Fill in and trap
 
+define constant $resolver-lock = make(<recursive-lock>);
+
 define method get-host-entry 
     (the-name :: <C-string>) => (host-entry :: <LPHOSTENT>)
   let host-entry :: <LPHOSTENT> = unix-gethostbyname(the-name);
@@ -244,51 +243,51 @@
     let error-code :: <integer> = unix-errno();
     select (error-code by \==)
       /*
-      $WSAHOST-NOT-FOUND => 
-	// Maybe it's a presentation address.  Try to covert the
-	// presentation address to a number.
-	let address-as-number :: <machine-word> =
-	  if (the-name = "255.255.255.255")
-	    accessor-htonl(#xFFFFFFFF) // probably don't need htonl
-	  else 
-	    let result = inet-addr(the-name);
-	    if (result == $INADDR-NONE) 
-	       unix-socket-error("get-host-entry",
-				  error-code: error-code,
-				  format-string: 
-				    "Couldn't translate %s as a host name",
-				  format-arguments:
-				    vector(as(<byte-string>,the-name)),
-				  host-name: the-name);
-	    end if;
-	    result
-	  end if;
-	with-stack-structure(hostnum-pointer :: <C-raw-unsigned-long*>)
-	  pointer-value(hostnum-pointer) := address-as-number;
-	  let result :: <LPHOSTENT> =
-	  unix-gethostbyaddr(pointer-cast(<C-char*>, hostnum-pointer),
-			      size-of(<C-raw-unsigned-long>),
-			      $AF-INET);
-	  if (null-pointer?(result))
-	    unix-socket-error("get-host-entry", 
-			       error-code: error-code,
-			       format-string: 
-				 "Couldn't translate %s as a host name",
-			       format-arguments: 
-				 vector(as(<byte-string>, the-name)),
-			       host-name: the-name);
-	  else
-	    host-entry := result;
-	  end if;
-	end with-stack-structure;
+        $WSAHOST-NOT-FOUND => 
+          // Maybe it's a presentation address.  Try to covert the
+          // presentation address to a number.
+          let address-as-number :: <machine-word> =
+          if (the-name = "255.255.255.255")
+            accessor-htonl(#xFFFFFFFF) // probably don't need htonl
+          else 
+            let result = inet-addr(the-name);
+            if (result == $INADDR-NONE) 
+              unix-socket-error("get-host-entry",
+                                error-code: error-code,
+                                format-string: 
+                                  "Couldn't translate %s as a host name",
+                                format-arguments:
+                                  vector(as(<byte-string>,the-name)),
+                                host-name: the-name);
+            end if;
+            result
+          end if;
+        with-stack-structure(hostnum-pointer :: <C-raw-unsigned-long*>)
+          pointer-value(hostnum-pointer) := address-as-number;
+          let result :: <LPHOSTENT> =
+            unix-gethostbyaddr(pointer-cast(<C-char*>, hostnum-pointer),
+                               size-of(<C-raw-unsigned-long>),
+                               $AF-INET);
+          if (null-pointer?(result))
+            unix-socket-error("get-host-entry", 
+                              error-code: error-code,
+                              format-string: 
+                                "Couldn't translate %s as a host name",
+                              format-arguments: 
+                                vector(as(<byte-string>, the-name)),
+                              host-name: the-name);
+          else
+            host-entry := result;
+          end if;
+        end with-stack-structure;
       */
       otherwise =>
-	unix-socket-error("get-host-entry", error-code: error-code,
-			   format-string: 
-			     "Error translating %s as a host name",
-			   format-arguments: 
-			     vector(as(<byte-string>, the-name)),
-			   host-name: the-name);
+        unix-socket-error("get-host-entry", error-code: error-code,
+                          format-string: 
+                            "Error translating %s as a host name",
+                          format-arguments: 
+                            vector(as(<byte-string>, the-name)),
+                          host-name: the-name);
     end select;
   end if;
   host-entry
@@ -360,22 +359,24 @@
   //  ISSUE: this isn't thread safe.  Need to lock so that other
   //  threads don't smash the single hostent strut before we can copy
   //  the fields out of it.
-  let host-entry :: <LPHOSTENT>
-    = select (input-name by instance?)
-	<C-char*> =>
-	  get-host-entry(input-name);
-	<byte-string> =>
-          with-C-string(input-name-as-C-string = input-name)
-	     get-host-entry(input-name-as-C-string);    
-          end with-c-string;
-      end select;
-  // now fill in the fields of the <ipv4-address>. Everything must be
-  // copied out of the
-  new-address.%host-name := as(<byte-string>, 
-			       pointer-cast(<C-string>, 
-					    host-entry.h-name-value));
-  new-address.%aliases := copy-aliases(host-entry.h-aliases-value);
-  new-address.%addresses := copy-addresses(host-entry);
+  with-lock($resolver-lock)
+    let host-entry :: <LPHOSTENT>
+      = select (input-name by instance?)
+          <C-char*> =>
+            get-host-entry(input-name);
+          <byte-string> =>
+            with-C-string(input-name-as-C-string = input-name)
+              get-host-entry(input-name-as-C-string);    
+            end with-c-string;
+        end select;
+    // now fill in the fields of the <ipv4-address>. Everything must be
+    // copied out of the
+    new-address.%host-name := as(<byte-string>, 
+                                 pointer-cast(<C-string>, 
+                                              host-entry.h-name-value));
+    new-address.%aliases := copy-aliases(host-entry.h-aliases-value);
+    new-address.%addresses := copy-addresses(host-entry);
+  end
 end method;
 
 // unix-gethostbyaddr error codes:
@@ -406,64 +407,65 @@
 
 define function accessor-get-host-by-address
     (new-address :: <ipv4-address>) => ();
-  //  ISSUE: this isn't thread safe.  Need to lock so that other
-  //  threads don't smash the single hostent strut before we can copy
-  //  the fields out of it.
-  let host-entry :: <LPHOSTENT>
-    // Could maybe use a with-initialized-pointer macro here
-    = with-stack-structure(hostnum-pointer :: <C-raw-unsigned-long*>)
-        pointer-value(hostnum-pointer) := 
-          new-address.numeric-host-address.network-order;
-	let gethostbyaddr-result :: <LPHOSTENT> =
-	  unix-gethostbyaddr(pointer-cast(<C-char*>, hostnum-pointer),
-			      size-of(<C-raw-unsigned-long>),
-			      $AF-INET);
-	if (null-pointer?(gethostbyaddr-result))
-	  let error-code :: <integer> = unix-errno();
-	  unix-socket-error("unix-gethostbyaddr", 
-			     error-code: error-code,
-			     format-string: 
-			       "Couldn't translate %s as a host address",
-			     format-arguments: 
-			       vector(new-address.host-address),
-			     host-address: new-address);
-	end if;
-        gethostbyaddr-result
-      end with-stack-structure;
-  // now fill in the fields of the <ipv4-address>. Everything must be
-  // copied out of the
-  new-address.%host-name := as(<byte-string>, 
-			       pointer-cast(<C-string>, 
-					    host-entry.h-name-value));
-  new-address.%aliases := copy-aliases(host-entry.h-aliases-value);
-  new-address.%addresses := copy-addresses(host-entry);
+  with-lock($resolver-lock)
+    let host-entry :: <LPHOSTENT>
+      // Could maybe use a with-initialized-pointer macro here
+      = with-stack-structure(hostnum-pointer :: <C-raw-unsigned-long*>)
+          pointer-value(hostnum-pointer) := 
+            new-address.numeric-host-address.network-order;
+          let gethostbyaddr-result :: <LPHOSTENT> =
+            unix-gethostbyaddr(pointer-cast(<C-char*>, hostnum-pointer),
+                               size-of(<C-raw-unsigned-long>),
+                               $AF-INET);
+          if (null-pointer?(gethostbyaddr-result))
+            let error-code :: <integer> = unix-errno();
+            unix-socket-error("unix-gethostbyaddr", 
+                              error-code: error-code,
+                              format-string: 
+                                "Couldn't translate %s as a host address",
+                              format-arguments: 
+                                vector(new-address.host-address),
+                              host-address: new-address);
+          end if;
+          gethostbyaddr-result
+        end with-stack-structure;
+    // now fill in the fields of the <ipv4-address>. Everything must be
+    // copied out of the
+    new-address.%host-name := as(<byte-string>, 
+                                 pointer-cast(<C-string>, 
+                                              host-entry.h-name-value));
+    new-address.%aliases := copy-aliases(host-entry.h-aliases-value);
+    new-address.%addresses := copy-addresses(host-entry);
+  end
 end function;
 
 
 define method accessor-get-port-for-service
     (service :: <c-string>, proto :: <c-string>) => (result :: <integer>)
-  let sp :: <LPSERVENT> = 
-  unix-getservbyname(service, proto);
-  if (null-pointer?(sp))
-    let service-error-code = unix-errno();
-    let high-level-error =
-      select (service-error-code by \==)
-        // TODO: High level error messages
-        /*
-	$WSAHOST-NOT-FOUND, $WSANO-RECOVERY, $WSANO-DATA =>
-	  make(<service-not-found>,
-	       format-string: "Service: %s not found for protocol: %s",
-	       format-arguments: vector(service, proto),
-	       service: as(<byte-string>, service),
-	       protocol: as(<byte-string>, proto));
-        */
-	otherwise => #f;
-      end select;
-    unix-socket-error("unix-getservbyname", error-code: service-error-code,
-		       high-level-error: high-level-error);
-  else
-    accessor-ntohs(sp.s-port-value);
-  end if
+  with-lock($resolver-lock)
+    let sp :: <LPSERVENT> = 
+      unix-getservbyname(service, proto);
+    if (null-pointer?(sp))
+      let service-error-code = unix-errno();
+      let high-level-error =
+        select (service-error-code by \==)
+          // TODO: High level error messages
+          /*
+            $WSAHOST-NOT-FOUND, $WSANO-RECOVERY, $WSANO-DATA =>
+            make(<service-not-found>,
+                 format-string: "Service: %s not found for protocol: %s",
+                 format-arguments: vector(service, proto),
+                 service: as(<byte-string>, service),
+                 protocol: as(<byte-string>, proto));
+          */
+          otherwise => #f;
+        end select;
+      unix-socket-error("unix-getservbyname", error-code: service-error-code,
+                        high-level-error: high-level-error);
+    else
+      accessor-ntohs(sp.s-port-value);
+    end if
+  end
 end method;
 
 define method accessor-get-port-for-service
@@ -472,7 +474,6 @@
   with-c-string (proto-as-c-string = proto) 
     accessor-get-port-for-service(service, proto-as-c-string);
   end
-
 end method;
 
 define method accessor-get-port-for-service



More information about the chatter mailing list