X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Finet.lisp;h=ebe6e35ab5ac80b5484300d517d00485c0aeac95;hb=7f4bf063d5f4716b87d34cc706f05b27ad3906b1;hp=e07f828aff4279c15e3713421eeba2c19fecc433;hpb=6fbe5560039a2c64c651ee0a9c69e33bce8c94a6;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp index e07f828..ebe6e35 100644 --- a/contrib/sb-bsd-sockets/inet.lisp +++ b/contrib/sb-bsd-sockets/inet.lisp @@ -82,46 +82,57 @@ a list of protocol aliases" (sockint::protoent-name protoent) (let ((index 0)) (loop - for alias = (sb-alien:deref (sockint::protoent-aliases protoent) index) - while (not (sb-alien:null-alien alias)) - do (incf index) - collect (sb-alien::c-string-to-string (sb-alien:alien-sap alias) - (sb-impl::default-external-format) - 'character)))))) + for alias = (sb-alien:deref + (sockint::protoent-aliases protoent) index) + while (not (sb-alien:null-alien alias)) + do (incf index) + collect (sb-alien::c-string-to-string + (sb-alien:alien-sap alias) + (sb-impl::default-external-format) + 'character)))))) #+(and sb-thread os-provides-getprotoby-r) (let ((buffer-length 1024) - (max-buffer 10000)) + (max-buffer 10000) + (result-buf nil) + (buffer nil) + #-solaris + (result nil)) (declare (type fixnum buffer-length) (type fixnum max-buffer)) (loop - (sb-alien:with-alien ((result-buf (* sockint::protoent) - (sb-alien:make-alien sockint::protoent)) - (buffer (* char ) - (sb-alien:make-alien sb-alien:char buffer-length)) - #-solaris - (result (* (* sockint::protoent)) - (sb-alien:make-alien (* sockint::protoent)))) - - (let ((res (sockint::getprotobyname-r name - result-buf - buffer - buffer-length - #-solaris - result))) - (if (eql res 0) - (progn - #-solaris - (when (sb-alien::null-alien (sb-alien:deref result 0)) - (error 'unknown-protocol :name name)) - (return-from get-protocol-by-name - (protoent-to-values result-buf))) - (let ((errno (sb-unix::get-errno))) - (if (eql errno sockint::erange) - (progn - (incf buffer-length 1024) - (if (> buffer-length max-buffer) - (error "Exceeded max-buffer of ~d" max-buffer))) - (error "Unexpected errno ~d" errno)))))))) + (unwind-protect + (progn + (setf result-buf (sb-alien:make-alien sockint::protoent) + buffer (sb-alien:make-alien sb-alien:char buffer-length)) + #-solaris + (setf result (sb-alien:make-alien (* sockint::protoent))) + (when (or (sb-alien:null-alien result-buf) + (sb-alien:null-alien buffer) + (sb-alien:null-alien result)) + (error "Could not allocate foreign memory.")) + (let ((res (sockint::getprotobyname-r + name result-buf buffer buffer-length #-solaris result))) + (cond ((eql res 0) + #-solaris + (when (sb-alien::null-alien (sb-alien:deref result 0)) + (error 'unknown-protocol :name name)) + (return-from get-protocol-by-name + (protoent-to-values result-buf))) + (t + (let ((errno (sb-unix::get-errno))) + (cond ((eql errno sockint::erange) + (incf buffer-length 1024) + (when (> buffer-length max-buffer) + (error "Exceeded max-buffer of ~d" max-buffer))) + (t + (error "Unexpected errno ~d" errno)))))))) + (when result-buf + (sb-alien:free-alien result-buf)) + (when buffer + (sb-alien:free-alien buffer)) + #-solaris + (when result + (sb-alien:free-alien result))))) #-(and sb-thread os-provides-getprotoby-r) (tagbody (flet ((get-it ()