PreviousUpNext

15.4.817  src/lib/internet/socket-junk.pkg

## socket-junk.pkg

# Compiled by:
#     src/lib/std/standard.lib

# Various utility functions for programming with sockets.

stipulate
    package c   =  char;                                        # char                                  is from   src/lib/std/char.pkg
    package fil =  file__premicrothread;                        # file__premicrothread                  is from   src/lib/std/src/posix/file--premicrothread.pkg
    package pc  =  parser_combinator;                           # parser_combinator                     is from   src/lib/src/parser-combinator.pkg
    package sok =  socket__premicrothread;                      # socket__premicrothread                is from   src/lib/std/socket--premicrothread.pkg
    package is  =  internet_socket__premicrothread;             # internet_socket__premicrothread       is from   src/lib/std/src/socket/internet-socket--premicrothread.pkg
    package tr  =  logger;                                      # logger                                is from   src/lib/src/lib/thread-kit/src/lib/logger.pkg
        #
        # To debug via tracelogging, annotate the code with lines like
        #
        #       trace {. sprintf "foo/top: bar d=%d" bar; };
herein

    package   socket_junk
    : (weak)  Socket_Junk                                       # Socket_Junk           is from   src/lib/internet/socket-junk.api
    {
        Port = PORT_NUMBER  Int
             | SERV_NAME    String
             ;
             #
             # A port can be identified by number, or by the name of a service.

        Hostname = HOST_NAME     String
                 | HOST_ADDRESS  dns_host_lookup::Internet_Address
                 ;

        socket_tracing = tr::make_logtree_leaf { parent => fil::all_logging, name => "socket_tracing", default => FALSE };
        trace =  tr::log_if socket_tracing 0;                   # Conditionally write strings to tracing.log or whatever.

        # This belongs in a null_or package:   XXX BUGGO FIXME
        #
        fun filter_partial predicate  NULL   =>  NULL;

            filter_partial predicate (THE x) =>  if (predicate x)  THE x;
                                                 else              NULL;
                                                 fi;
        end;

        fun scan_name getc stream
            =
            {   fun is_name_chr ('.', _) =>  TRUE;
                    is_name_chr ('-', _) =>  TRUE;
                    is_name_chr ( c,  _) =>  c::is_alphanumeric  c;
                end;

                fun get_name (stream, cl)
                    =
                    case (filter_partial is_name_chr (getc stream))
                        #
                        THE (c, stream') =>  get_name (stream', c ! cl);
                        NULL             =>  THE (implode (reverse cl), stream);
                    esac;


                case (filter_partial (c::is_alpha o #1) (getc stream))
                    #
                    THE (c, stream) =>  get_name (stream, [c]);
                    NULL            =>  NULL;
                esac;
            };

        # Scan an address, which has the form
        #   address [ ":" port ]
        # where the address may be either numeric
        # or symbolic host name and the port is
        # either a service name or a decimal number.
        #
        # Legal host names must begin with a letter,
        # and may contain any alphanumeric character,
        # the minus sign (-) and period (.), where
        # the period is used as a domain separator.  
        #
        fun scan_addr getc stream
            =
            pc::seq_with
              (\\ (host, port) =  { host, port })
              ( pc::or_op
                  ( pc::wrap (scan_name, HOST_NAME),
                    pc::wrap (dns_host_lookup::scan, HOST_ADDRESS)
                  ),
                pc::option
                  ( pc::seq_with
                      #2
                      ( pc::eat_char (\\ c =  (c == ':')),
                        pc::or_op
                          ( pc::wrap (scan_name, SERV_NAME),
                            pc::wrap (int::scan number_string::DECIMAL, PORT_NUMBER)
                          )
                      )
                  )
              )
              getc
              stream;

        addr_from_string
           =
           number_string::scan_string scan_addr;

        exception BAD_ADDRESS  String;

        fun resolve_addr { host, port }
            =
            {   fun err (a, b)
                    =
                    raise exception BAD_ADDRESS (cat [a, " \"", b, "\" not found"]);

                my (name, address)
                    =
                    case host

                        HOST_NAME s
                            =>
                            case (dns_host_lookup::get_by_name s)
                                #
                                NULL      =>  err ("hostname", s);
                                THE entry =>  (s, dns_host_lookup::address entry);
                            esac;

                        HOST_ADDRESS address
                            =>
                            case (dns_host_lookup::get_by_address address)
                                #
                                NULL      =>  err ("host address", dns_host_lookup::to_string address);
                                THE entry =>  (dns_host_lookup::name entry, address);
                            esac;
                    esac;


                port =  case port

                            THE (PORT_NUMBER n)
                                =>
                                THE n;

                            THE (SERV_NAME s)
                                =>
                                case (net_service_db::get_by_name (s, NULL))

                                     THE entry =>  THE (net_service_db::port entry);
                                     NULL      =>  err("service", s);
                                esac;

                            NULL => NULL;

                        esac;


                { host => name, address, port };
            };

        Stream_Socket(X)
            =
            sok::Socket (X,  sok::Stream( sok::Active ));


        # Establish a client-side connection
        # to a INET domain stream socket:
        #
        fun connect_client_to_internet_domain_stream_socket { address, port }
            =
            socket
            where
                socket =  is::tcp::make_socket ();
                #
                sok::connect (socket, is::to_address (address, port));
            end;



        # Read exactly n bytes from a stream socket:
        #
        # If the server closes the connection cleanly
        # we get 0 bytes back (as opposed to an error).
        #
        # (I've seen the X server silently close the
        # socket when we provide no authentication info.)
        #
        fun receive_vector (socket, n)
            =
            {   fun get (0, data)
                        =>
                        {
                            vector_of_one_byte_unts::cat (reverse data);
                        };

                    get (n, data)
                        =>
                        {
                            v = sok::receive_vector (socket, n);

                            if (vector_of_one_byte_unts::length v == 0)
                                #
                                raise exception winix__premicrothread::RUNTIME_EXCEPTION("closed socket", NULL);
                            else
                                get (n - vector_of_one_byte_unts::length v, v ! data);
                            fi;
                        };
                end;

                if (n < 0)   raise exception SIZE;
                else         get(n, []);
                fi;
            };

        fun receive_string  arg
            =
            byte::bytes_to_string
                (receive_vector  arg);



        # Send the complete contents of a vector:
        #
        fun send_vector (socket, vec)
            =
            put 0
            where
                len =   vector_of_one_byte_unts::length  vec;
                #
                fun send i
                    =
                    sok::send_vector
                      ( socket,
                        vector_slice_of_one_byte_unts::make_slice
                            (vec, i, NULL)
                      );

                fun put i
                    =
                    if (i < len)
                        put (i + send i);
                    fi;
            end;

        fun send_string (socket, string)
            =
            send_vector
              ( socket,
                byte::string_to_bytes  string
              );



        # Send the complete contents of an rw_vector:
        #
        fun send_rw_vector (socket, rw_vector)
            =
            put 0
            where
                len = rw_vector_of_one_byte_unts::length  rw_vector;

                fun send i
                    =
                    sok::send_rw_vector
                      ( socket,
                        rw_vector_slice_of_one_byte_unts::make_slice
                           (rw_vector, i, NULL)
                      );

                fun put i
                    =
                    if (i < len)
                         put (i + send i);
                    fi;
            end;
    };

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext