PreviousUpNext

15.4.1669  src/lib/x-kit/xclient/src/wire/display.pkg

## xdisplay.pkg
#
# newworld version of src/lib/x-kit/xclient/src/wire/display-old.pkg
#
# Opening and closing a given screen
# on a given X server.  See overview comments in:
#
#     src/lib/x-kit/xclient/src/wire/display.api

# Compiled by:
#     src/lib/x-kit/xclient/xclient-internals.sublib



stipulate
    include package   threadkit;                                        # threadkit                             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    package mps =  microthread_preemptive_scheduler;                    # microthread_preemptive_scheduler      is from   src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg
    #
    package cxa =  crack_xserver_address;                               # crack_xserver_address                 is from   src/lib/x-kit/xclient/src/wire/crack-xserver-address.pkg
    package dns =  dns_host_lookup;                                     # dns_host_lookup                       is from   src/lib/std/src/socket/dns-host-lookup.pkg
    package i2s =  xserver_info_to_string;                              # xserver_info_to_string                is from   src/lib/x-kit/xclient/src/to-string/xserver-info-to-string.pkg
    package sci =  socket_closer_imp_old;                               # socket_closer_imp_old                 is from   src/lib/x-kit/xclient/src/wire/socket-closer-imp-old.pkg
    package sok =  socket__premicrothread;                              # socket__premicrothread                is from   src/lib/std/socket--premicrothread.pkg
    package soj =  socket_junk;                                         # socket_junk                           is from   src/lib/internet/socket-junk.pkg
    package uds =  unix_domain_socket__premicrothread;                  # unix_domain_socket__premicrothread    is from   src/lib/std/src/socket/unix-domain-socket--premicrothread.pkg
    package v2w =  value_to_wire;                                       # value_to_wire                         is from   src/lib/x-kit/xclient/src/wire/value-to-wire.pkg
    package v8s =  vector_slice_of_one_byte_unts;                       # vector_slice_of_one_byte_unts         is from   src/lib/std/src/vector-slice-of-one-byte-unts.pkg
    package w2v =  wire_to_value;                                       # wire_to_value                         is from   src/lib/x-kit/xclient/src/wire/wire-to-value.pkg
    package w8v =  vector_of_one_byte_unts;                             # vector_of_one_byte_unts               is from   src/lib/std/src/vector-of-one-byte-unts.pkg
    package g2d =  geometry2d;                                          # geometry2d                            is from   src/lib/std/2d/geometry2d.pkg
    package xt  =  xtypes;                                              # xtypes                                is from   src/lib/x-kit/xclient/src/wire/xtypes.pkg
    package xtr =  xlogger;                                             # xlogger                               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
    package wnx =  winix__premicrothread;                               # winix__premicrothread                 is from   src/lib/std/winix--premicrothread.pkg
    package sj  =  socket_junk;                                         # socket_junk                           is from   src/lib/internet/socket-junk.pkg
#    package ps  =  proto_socket__premicrothread;                       # proto_socket__premicrothread          is from   src/lib/std/src/socket/proto-socket--premicrothread.pkg
    #
    trace =  xtr::log_if  xtr::io_logging  0;                           # Conditionally write strings to tracing.log or whatever.
herein


    package   display
    : (weak)  Display                                                   # Display                               is from   src/lib/x-kit/xclient/src/wire/display.api
    {
        exception XSERVER_CONNECT_ERROR = cxa::XSERVER_CONNECT_ERROR;

        Xscreen =     { id:                     Int,                            # Number of this screen.
                        #
                        root_window_id:         xt::Window_Id,                  # Root window id of this screen.
                        default_colormap:       xt::Colormap_Id,                # 

                        white_rgb8:             rgb8::Rgb8,                     # White and Black pixel values.
                        black_rgb8:             rgb8::Rgb8,

                        root_input_mask:        xt::Event_Mask,                 # Initial root input mask.

                        size_in_pixels:         g2d::Size,                      # Width and height in pixels.
                        size_in_mm:             g2d::Size,                      # Width and height in millimeters.

                        root_visual:            xt::Visual,
                        backing_store:          xt::Backing_Store,

                        visuals:                List( xt::Visual ),

                        save_unders:            Bool,

                        min_installed_cmaps:    Int,
                        max_installed_cmaps:    Int
                      };

        Xdisplay =    { socket:                 sj::Stream_Socket(Int),         # Actual unix socket fd, wrapped up a bit. The 'Int' part is bogus -- I don't get what Reppy was trying to do with that phantom type.
                        #
                        name:                   String,                         # "host:display.screen". 
                        vendor:                 String,                         # Name of the server's vendor. 

                        default_screen:         Int,                            # Number of the default screen. 
                        screens:                List( Xscreen ),                # Screens attached to this display. 
                        pixmap_formats:         List( xt::Pixmap_Format ),
                        max_request_length:     Int,

                        image_byte_order:       xt::Order,
                        bitmap_bit_order:       xt::Order,

                        bitmap_scanline_unit:   xt::Raw_Format,
                        bitmap_scanline_pad:    xt::Raw_Format,

                        min_keycode:            xt::Keycode,
                        max_keycode:            xt::Keycode,

                        next_xid:               Void -> xt::Xid                 # resource id allocator. Implemented below by spawn_xid_factory_thread().
                      };


        # Return index of first bit set (starting at 1),
        # return 0 if n == 0, and
        # assume that n > 0.
        #
        fun find_first_bit_set 0u0
                =>
                xgripe::xerror "bogus resource mask";

            find_first_bit_set w
                =>
                lp (w, 0u1)
                where
                   fun lp (w, i)
                        =
                        unt::bitwise_and (w, 0u1) == 0u0
                            ??  lp (unt::(>>) (w, 0u1), i+0u1)
                            ::  i;


                end;
        end;

        # Handle initial handshake stuff with xserver via a
        # freshly opened unix- or internet-domain socket,
        # then build an xsocket threadset layer on top of it
        # (inbuf_imp, outbuf_imp, sequencer_imp, decode_xpackets_imp): 
        # 
        fun say_hello_to_xserver (socket: socket_junk::Stream_Socket(X), xauthentication, canonical_display_name, screen_number)
            =
            {
printf "say_hello_to_xserver/AAA -- display.pkg\n";

# +DEBUG
                                                                                                trace  {.  "display.pkg: say_hello_to_xserver/TOP (initializing xsocket to \"" + canonical_display_name + "\")";  };
                                                                                                trace  {.  "display.pkg: say_hello_to_xserver: computing connect_msg";  };
# -DEBUG

                connect_msg
                    =
                    v2w::encode_xserver_connection_request
                      {
                        minor_version => 0,
                        xauthentication
                      };

#                                                                                               trace  {.  "display.pkg: say_hello_to_xserver: connect_msg x=" + (xok::bytes_to_hex connect_msg) + " s='" + (xok::bytes_to_ascii connect_msg) + "'";  };
                                                                                                trace  {.  "display.pkg: say_hello_to_xserver: Sending connect_msg to socket"; };

                soj::send_vector (socket, connect_msg);

# +DEBUG
#                                                                                               trace  {. "display.pkg: say_hello_to_xserver: connect_msg sent to socket, sleeping for 2 seconds"; };
# -DEBUG

                # ddeboer, fall 2004: error in ssh tunnelling happens in following line 
                # modified to retry on exception.

#               fun sleep n
#                   =
#                   block_until_mailop_fires (timeout_in' (float::from_int n));


                                                                                                trace  {. "display.pkg: say_hello_to_xserver: connect_msg sent to socket, now reading back connection reply header"; };


                                                                                                # exceptions                    is from   src/lib/std/exceptions.pkg
                                                                                                # large_unt                     is from   src/lib/std/large-unt.pkg
                                                                                                # pack_big_endian_unt16         is from   src/lib/std/src/pack-big-endian-unt16.pkg

                header = soj::receive_vector (socket, 8)
                         except
                             wnx::RUNTIME_EXCEPTION("closed socket", NULL)
                                 =
                                 # I was getting this error when I failed to supply
                                 # authentication -- you'd think the server would
                                 # return a 0u2 "additional authentication required"
                                 # reply, but apparently not.
                                 #
                                 # Anyhow, we can at least generate an error more
                                 # informative than "I/O to closed socket":      -- 2010-02-28 CrT
                                 #
                                 case xauthentication
                                     #
                                     NULL => raise exception XSERVER_CONNECT_ERROR (sprintf "X server %s closed connection without replying, perhaps because we supplied no authentication." canonical_display_name);
                                     _    => raise exception XSERVER_CONNECT_ERROR (sprintf "X server %s closed connection without replying."                                                canonical_display_name);
                                 esac; 

                len = 4 * large_unt::to_int_x (pack_big_endian_unt16::get_vec (header, 3));     # "4 * ..." because X reports packet lengths in multiples of 32 bits.

# +DEBUG
                                                                                                trace  {. sprintf "display.pkg: say_hello_to_xserver: reply length extracted from header d=%d" len; };
# -DEBUG



                fun get_reply len
                    =
                    {
                                                                                                trace {. sprintf "display.pkg: say_hello_to_xserver: get_reply: Now  calling soj::receive_vector to read connection reply body (%d bytes)..." len; };
                        reply =  soj::receive_vector (socket, len);
                                                                                                trace {. sprintf "display.pkg: say_hello_to_xserver: get_reply: DONE calling soj::receive_vector to read connection reply body (%d bytes)..." len; };
                        reply;
                    };

                fun get_msg reply
                    =
                    byte::unpack_string_vector (
                        v8s::make_slice(
                            reply,
                            0,
                            THE (one_byte_unt::to_int_x (w8v::get (header, 1)))
                        )
                    );
                                                                                                # socket__premicrothread                is from   src/lib/std/socket--premicrothread.pkg

result =
                case (w8v::get (header, 0))
                    #
                    0u1 =>
                        {
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: header byte #0 is 1 (Success)"; };
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Now  calling get_reply to read complete reply"; };
                            reply =  get_reply  len;
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Done calling get_reply to read complete reply"; };
                                 
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Now  calling w2v::decode_connect_request_reply"; };
                            xserver_info = w2v::decode_connect_request_reply  (header, reply);
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Done calling w2v::decode_connect_request_reply"; };

# +DEBUG
                                                                                                trace  {. "Connect request reply info:"; };
                                                                                                trace  {. i2s::xserver_info_to_string  xserver_info; };
# -DEBUG
printf "say_hello_to_xserver: xserver_info = %s  -- display.pkg\n" (i2s::xserver_info_to_string  xserver_info);
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Now  calling xok::make_xsocket"; };
#                           xsocket =  xok::make_xsocket  socket;
                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Done calling xok::make_xsocket"; };

                                                                                                trace  {. "display.pkg: say_hello_to_xserver: Returning."; };
                            (socket, xserver_info, canonical_display_name, screen_number);
                        };

                    0u0 =>
                        {   sok::close  socket;
                            msg = "X server refused connection: " + get_msg (get_reply len);
                            log::fatal msg;
                            raise exception DIE msg;
                        };

                    0u2 =>
                        {   sok::close  socket;
                            msg = "X server demanded additional authentication";
                            log::fatal msg;
                            raise exception DIE msg;
                        };

                    x   =>
                        {   sok::close  socket;
                            msg = sprintf "X server returned unknown reply op %d" (one_byte_unt::to_int x);
                            log::fatal msg;
                            raise exception DIE msg;
                        };
                esac; 
printf "say_hello_to_xserver/ZZZ -- display.pkg\n";   result;
            };

        # Crack 'raw_display_name', open
        # a unix- or internet-domain
        # socket (as appropriate) and
        # do the initial handshake with
        # the X server:
        #
        fun connect_to_xserver
            ( raw_display_name: String,                                                         # ":0.0" or "192.168.0.1:0.0" or such, often from unix DISPLAY environment variable.
              xauthentication:  Null_Or( xt::Xauthentication )                                  # Ultimately ~/.Xauthority
            )
            =
            {
printf "connect_to_xserver/AAA raw_display_name s='%s'  -- display.pkg\n" raw_display_name;
                # Digest a user-level X server spec
                # into a form easier to work with:
                #
                (cxa::crack_xserver_address  raw_display_name)
                    ->
                    { address:                  cxa::Xserver_Address,
                      canonical_display_name:   String,
                      screen:                   Int
                    };
printf "connect_to_xserver/BBB crack_server_address says canonical_display_name s='%s'  -- display.pkg\n" canonical_display_name;

                                                                                                trace {. sprintf "display.pkg: connect_to_xserver: address s='%s' screen d=%d canonical_display_name s='%s'" (cxa::to_string address) screen canonical_display_name; };


                fun open_internet_domain_socket
                    (
                      address:  dns::Internet_Address,
                      port:     Int
                    )
                    =
                    {




                                                                                                # internet_socket__premicrothread       is from   src/lib/std/src/socket/internet-socket--premicrothread.pkg
                        # Invoke the glibc socket() fn via
                        # a few layers of wrapping:
                        # 
                        socket = internet_socket__premicrothread::tcp::make_socket ();



                        sok::connect (socket, internet_socket__premicrothread::to_address (address, port))
                        except
                            winix::RUNTIME_EXCEPTION (s, _)
                                =
                                raise exception XSERVER_CONNECT_ERROR s;


printf "open_internet_domain_socket calling say_hello_to_xserver  -- display.pkg\n";
                        say_hello_to_xserver
                            (socket, xauthentication, canonical_display_name, screen);

                    };


                case address
                    #
                    cxa::UNIX path
                        =>
                        {
                            socket =  uds::stream::make_socket ();
                            #
                            socket_address = uds::string_to_unix_domain_socket_address  path;

                            sok::connect (socket, socket_address)
                            except
                            winix::RUNTIME_EXCEPTION (s, _)
                                =
                                {
                                    raise exception XSERVER_CONNECT_ERROR s;
                                };

printf "connect_to_xserver/CCC calling say_hello_to_xserver on UNIX socket  -- display.pkg\n";
                            say_hello_to_xserver (socket, xauthentication, canonical_display_name, screen);
                        };

                    cxa::INET_ADDRESS (host, port)
                        =>
                        case (dns::from_string  host)
                            #
                            THE address =>  open_internet_domain_socket (address, port);
                            NULL        =>  raise exception XSERVER_CONNECT_ERROR "Bad IP address format";
                        esac;

                    cxa::INET_HOSTNAME (host, port)
                        =>
                        case (dns::get_by_name  host)
                            #
                            THE entry =>  open_internet_domain_socket (dns::address entry, port);
                            NULL      =>  raise exception XSERVER_CONNECT_ERROR (sprintf "Host '%s' not found" host);
                        esac;
                esac;
            };                          # fun connect_to_xserver

        # Spawn an xid-factory thread, return
        # a plea-slot connected to it.
        #
        fun spawn_xid_factory_thread (base, mask)
            =
            {   result_slot =  make_mailslot ();

                # For background on the algorithm see Note[1] in:
                # 
                #     src/lib/x-kit/xclient/src/wire/xtypes.pkg
                #
                # I have serious doubts about the correctness of this
                # code.  At the very least, it fails to check for and
                # warn about exhaustion of assigned space.  XXX BUGGO FIXME.

                increment =  find_first_bit_set  mask;

                fun loop u
                    =
                    {   put_in_mailslot (result_slot, xt::xid_from_unt u);
                        #
                        loop (u + increment);
                    };

                #  make_thread "xdisplay"  {. loop base; }; 

                xtr::make_thread  "xid-factory"  {. loop base; };

                {. take_from_mailslot  result_slot; };
            };

        fun make_screen
            #
            screen_number
            #   
            # From w2v::get_screen:
            #
            { root_window,
              default_colormap,
              white_rgb8,
              black_rgb8,
              input_masks,
              pixels_wide,
              pixels_high,
              millimeters_wide,
              millimeters_high,
              installed_colormaps => { min, max },
              root_visualid,
              backing_store,
              save_unders,
              root_depth,
              visuals
            }
            =
              ( { id => screen_number,
                  root_window_id => root_window,
                  default_colormap,
                  white_rgb8,
                  black_rgb8,
                  root_input_mask => input_masks,
                  #
                  size_in_pixels => { wide => pixels_wide,      high => pixels_high      },
                  size_in_mm     => { wide => millimeters_wide, high => millimeters_high },
                  #
                  min_installed_cmaps => min,
                  max_installed_cmaps => max,

                  root_visual =>  get_root_visual  visuals,
                  backing_store,
                  save_unders,
                  visuals
                }: Xscreen
              ) 
            where
                fun get_root_visual []
                        =>
                        xgripe::xerror  "cannot find root visual";

                    get_root_visual ((xt::NO_VISUAL_FOR_THIS_DEPTH _) ! r)
                        =>
                        get_root_visual r;

                    get_root_visual ((v as xt::VISUAL { visual_id, depth, ... } ) ! r)
                        =>
                        if (visual_id == root_visualid   and
                            depth     == root_depth)
                            #
                            v;
                        else
                            get_root_visual r;
                        fi;
                end;
            end;                                # fun make_screen 

        fun make_screens  info_list
            =
            make_s (0, info_list)
            where
                fun make_s (i, [])       =>  [];
                    make_s (i, info ! r) =>  (make_screen i info) ! make_s (i+1, r);
                end;
            end;


        # This is the main entrypoint into this file.
        # Unit testing aside, it is called only from
        #
        #     fun make_xsession
        # in
        #     src/lib/x-kit/xclient/src/window/xsession-old.pkg
        #
        # -- see comments there.
        #
        fun open_xdisplay
            {
              display_name:     String,                                 # ":0.0" or unix:0.0" or "foo.com:0.0" or "192.168.0.1:0.0" or such.
              xauthentication:  Null_Or( xt::Xauthentication )          # Ultimately from ~/.Xauthority
            }
            =
            {
printf "open_display/AAA calling   connect_to_xserver -- display.pkg\n";
                # Open unix- or internet-domain
                # socket and do initial handshake
                # with x-server:
                #               
                (connect_to_xserver (display_name, xauthentication))
                    ->
                    (
                      socket,
                      server_info,                                      # Protocol number, vendor etc etc -- see decode_connect_request_reply in src/lib/x-kit/xclient/src/wire/wire-to-value.pkg
                      normalized_xserver_address,                       # 
                      screen_number                                     # Almost always zero.
                    );
printf "open_display/BBB back from connect_to_xserver -- display.pkg\n";

#               sci::note_xsocket  xsocket;                             # Arrange to have xserver socket cleanly closed upon application exit.

                screens =  make_screens  server_info.screens;

                display =             { socket,
                                        name                 =>  normalized_xserver_address,
                                        vendor               =>  server_info.vendor,

                                        screens,
                                        default_screen       =>  screen_number,

                                        pixmap_formats       =>  server_info.pixmap_formats,
                                        max_request_length   =>  server_info.max_request_length,

                                        image_byte_order     =>  server_info.image_byte_order,
                                        bitmap_bit_order     =>  server_info.bitmap_order,

                                        bitmap_scanline_unit =>  server_info.bitmap_scanline_unit,
                                        bitmap_scanline_pad  =>  server_info.bitmap_scanline_pad,

                                        min_keycode          =>  server_info.min_keycode,
                                        max_keycode          =>  server_info.max_keycode,

                                        next_xid             =>  spawn_xid_factory_thread (server_info.xid_base, server_info.xid_mask)
                                      }:                         Xdisplay
                                      ;

# printf "open_xdisplay(%s)/EEE    -- display.pkg\n" display_name;
                # Set up a handler for error messages
                # from the X server, with a watcher
                # to notify us if it dies:
                #
#               fun err_handler ()
#                   =
#                   {   (xok::read_xerror  xsocket)
#                           ->
#                           (seqn, err_msg);
#                           
#                                                                       # unt                   is from   src/lib/std/unt.pkg
#                                                                       # number_string         is from   src/lib/std/src/number-string.pkg
#                                                                       # xerror_to_string      is from   src/lib/x-kit/xclient/src/to-string/xerror-to-string.pkg
#                       trace {.
#                           #
#                           sprintf "ERROR on request #%s: %s"
#                               #
#                               (unt::format  number_string::DECIMAL  seqn)
#                               (xerror_to_string::xerror_to_string (w2v::decode_error err_msg));
#                       };
#
#                       err_handler ();
#                   };

#               xtr::make_thread  "err_handler"  err_handler;

printf "open_display/ZZZ  -- display.pkg\n";
                display;
          };

        # close_xdisplay:  xdisplay -> Void 
        #
        fun close_xdisplay ({ socket, ... }: Xdisplay )
            =
            sok::close socket;

        fun depth_of_visual (xt::NO_VISUAL_FOR_THIS_DEPTH depth) =>  depth;
            depth_of_visual (xt::VISUAL { depth, ... } )         =>  depth;
        end;

        fun display_class_of_visual (xt::NO_VISUAL_FOR_THIS_DEPTH _) =>  NULL;
            display_class_of_visual (xt::VISUAL { ilk, ... } )       =>  THE ilk;
        end;

    };                  # package xdisplay 
end;                    # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext