## 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.sublibstipulate
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.pkgresult =
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