15.4.1176  src/lib/std/src/socket/nonblocking-socket-junk.pkg

## nonblocking-socket-junk.pkg
## Author: Matthias Blume (blume@tti-c.org)

# Compiled by:
#     src/lib/std/src/standard-core.sublib


#   Check for would-block error condition on posix sockets.
#
# This package is used (only) in:
#
#     src/lib/std/src/socket/socket-guts.pkg

stipulate
    package psx =  posix_1003_1b;               # posix_1003_1b         is from   src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg
herein

    package nonblocking_socket_junk: (weak)   api {
                                         make_io_descriptor:  Int -> pre_os::io::Io_Descriptor;
                                         wrap_nb_o:  (X -> Y   ) -> (X -> Null_Or(Y) );
                                         wrap_nb_b:  (X -> Void) -> (X -> Bool);
                                    }
    {
        make_io_descriptor = pre_os::io::int_to_iod;

        # The following is essentially lifted from the threadkit implementation's
        # handling of non-blocking socket I/O.  I am not sure whether
        # conflating EINPROGRESS, EAGAIN, and EWOULDBLOCK is exactly
        # the right thing, though...    -- Matthias     XXX BUGGO FIXME

        stipulate
            # Construct a list of error values corresponding to the
            # POSIX errors EINPROGRESS, EAGAIN and EWOULDBLOCK.  These
            # are values we might get back from an attempt to read a
            # file descriptor which has been set nonblocking:
            #
            #    EINPROGRESS:  Three-way handshake to connect to remote socket
            #              has been started but not completed.
            #
            #    EAGAIN, EWOULDBLOCK:  Generic indication that the syscall
            #                      attempt achieved no progress.
            #
            # According to R Stevens, Unix Network Programming,
            # on most systems EAGAIN == EWOULDBLOCK (check <sys/errno.h>)
            # so we'll just have two values in the list, but POSIX allows
            # either in some contexts, and for them to be distinct:
            #
            block_errors
                =
                case (psx::error::syserror "wouldblock")
                    #          
                    THE ewouldblock => [ ewouldblock, psx::error::again, psx::error::inprogress ];
                    NULL            => [              psx::error::again, psx::error::inprogress ];
                esac;


            fun block_err (winix_guts::RUNTIME_EXCEPTION(_, THE err))
                    =>
                    list::exists  (fn err' =  err == err')  block_errors;

                block_err _
                    =>
                    FALSE;
            end;

        herein

            # Execute f(x);
            # If it returns normally return THE (result);
            # If it throws EAGAIN, EWOULDBLOCK or EINPROGRESS, return NULL.
            # Otherwise propagage the exception thrown.
            #
            fun wrap_nb_o f x                                   # "nb" == "non-blocking"
                =
                THE (f x)
                except ex
                    =
                    if (block_err ex)   NULL;
                    else                raise exception ex;
                    fi;


            # Execute f(x);
            # If it returns normally return TRUE.
            # If it throws EAGAIN, EWOULDBLOCK or EINPROGRESS, return FALSE.
            # Otherwise propagage the exception thrown.
            #
            fun wrap_nb_b f x                                   # "nb" == "non-blocking"
                =
                {   f x;
                    TRUE;
                }
                except ex
                    =
                    if (block_err ex)   FALSE;
                    else                raise exception ex;
                    fi;
        end;
    };
end;

## Copyright (c) 2003 by The Fellowship of SML/NJ
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.