## authentication.pkg
#
# For motivation and overview see comments in:
#
# src/lib/x-kit/xclient/xclient.api#
# Support for X11 authentication. The authentication file, which is
# specified by the XAUTHORITY variable (default $HOME/.Xauthority),
# consists of a sequence of entries with the following format:
#
# 2 bytes Family value (second byte is as in protocol HOST)
# 2 bytes address length (always MSB first)
# A bytes host address (as in protocol HOST)
# 2 bytes display "number" length (always MSB first)
# S bytes display "number" string
# 2 bytes name length (always MSB first)
# N bytes authorization name string
# 2 bytes data length (always MSB first)
# D bytes authorization data string
#
# For more information see the README in the libxau sourcetree from X.org.
#
# This implementation is partially based on code contributed by Juergen Buntrock.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# This package is (only) used in:
#
# src/lib/x-kit/widget/old/lib/run-in-x-window-old.pkg### "Adam and Eve had many advantages, but the
### principal one was that they escaped teething."
###
### -- Pudd'nhead Wilson's Calendar
stipulate
package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package bio = data_file__premicrothread; # data_file__premicrothread is from src/lib/std/src/posix/data-file--premicrothread.pkg package ss = substring; # substring is from src/lib/std/substring.pkg package dns = dns_host_lookup; # dns_host_lookup is from src/lib/std/src/socket/dns-host-lookup.pkg package cxa = crack_xserver_address; # crack_xserver_address is from src/lib/x-kit/xclient/src/wire/crack-xserver-address.pkgherein
package authentication {
#
w8vextract = vector_slice_of_one_byte_unts::to_vector o vector_slice_of_one_byte_unts::make_slice;
get8 = one_byte_unt::to_int o vector_of_one_byte_unts::get;
# This version of get16 handles unaligned data:
#
fun get16 (s, i)
=
{ s = w8vextract (s, i, THE 2);
#
large_unt::to_int (pack_big_endian_unt16::get_vec (s, 0));
};
fun get_data (s, i, n)
=
w8vextract (s, i, THE n);
# Extract n bytes at offset i within s,
# return as a String:
#
fun get_string (s, i, n)
=
byte::unpack_string_vector (vector_slice_of_one_byte_unts::make_slice (s, i, THE n));
# Extract 4-byte IP address from offset 'i'
# in string 's' and return as a "127.0.0.1"
# style dotted ascii String:
#
fun get_address_string (s, i, n)
=
{ address_parts
=
(vector_slice_of_one_byte_unts::fold_backward
(\\ (e, a)
=
(int::to_string (char::to_int (byte::byte_to_char e))) ! a
)
[]
(vector_slice_of_one_byte_unts::make_slice (s, i, THE n))
);
case (n, address_parts)
#
(4, [a, b, c, d]) => a + "." + b + "." + c + "." + d;
_ => ""; # XXX BUGGO FIXME This can't be optimal.
esac;
};
# The different family codes
# (from X.h and xc/lib/Xau/Xauth.h)
#
family_internet = 0;
family_decnet = 1;
family_chaos = 2;
family_local = 256;
family_wild = 65535;
# Return the default name of the authentication file (either
# specified by the XAUTHORITY environment variable, or the
# file $HOME/.Xauthority. If neither XAUTHORITY nor HOME
# are defined, then ".Xauthority" is returned.
#
fun get_xauthority_filename ()
=
case (winix::process::get_env "XAUTHORITY")
#
THE filename => filename;
#
NULL
=>
case (winix::process::get_env "HOME")
#
THE path => path + "/.Xauthority";
NULL => ".Xauthority";
esac;
esac;
# Read the entire contents of a .Xauthority file:
#
fun read_file filename
=
{ stream = data_file__premicrothread::open_for_read filename;
#
contents = data_file__premicrothread::read_all stream;
data_file__premicrothread::close_input stream;
contents;
};
# Extract an authentication entry from
# given offset in given file_contents.
#
# Our effective type here is
#
# file_contents -> offset -> entry
#
# where file_contents is a bytestring (vector_of_one_byte_unts)
# holding the contents of a ~/.Xauathority file or
# such and 'offset' is an Int giving a byte offset
# within file_contents.
#
fun extract_authentication_entry file_contents
=
{ len = vector_of_one_byte_unts::length file_contents;
fun get_len start
=
get16 (file_contents, start - 2);
# Extract one .Xauthority file record from
# given offset within 'file_contents' bytestring:
#
fun extract offset
=
if (offset < len)
#
addr_start = 4 + offset;
addr_len = get_len addr_start;
display_start = addr_start + addr_len + 2;
display_len = get_len display_start;
name_start = display_start + display_len + 2;
name_len = get_len name_start;
data_start = name_start + name_len + 2;
data_len = get_len data_start;
next = data_start + data_len;
# Added following line, Feb 2005, ddeboer
family = get16 (file_contents, offset);
# modified by ddeboer:
# entries of family=familyInternet are stored as 4-byte ip addresses.
# it seems that we must convert these into hostnames for comparison...?!?
# original:
# family = get16 (file_contents, offset),
# address = get_string (file_contents, addrStart, addrLen),
#
address
=
if (family == family_internet)
string = get_address_string (file_contents, addr_start, addr_len);
# For 110.59, Dusty Deboer replaced the below by just
#
string;
# string = get_address_string (file_contents, addr_start, addr_len);
#
# case (dns_host_lookup::from_string string)
#
# NULL => "";
#
# THE ia => case (dns_host_lookup::get_by_address ia)
# NULL => "";
# THE e => (dns_host_lookup::name e);
# esac;
# esac;
else
get_string (file_contents, addr_start, addr_len);
fi;
# end modification
THE (
xt::XAUTHENTICATION {
family,
address,
display => get_string (file_contents, display_start, display_len ),
name => get_string (file_contents, name_start, name_len),
data => get_data (file_contents, data_start, data_len)
},
next
);
else
NULL;
fi;
extract;
};
# Search the default authentication file for the first entry that
# matches the family, network address and display number.
#
# If no such match is found, return NULL.
#
# The * value family_wild matches anything, as do the
# empty strings when given for address or display.
#
fun get_xauthority_file_entry_by_address
{
family: Int, # family_wild, family_local, family_internet ...
address: String, # From gethostname(2) or such.
display: String # E.g. "0" -- from "localhost:0.1" DISPLAY string or such.
}
=
{ extract_authentication_entry
=
extract_authentication_entry (read_file (get_xauthority_filename()));
# hack by ddeboer, Feb 2005 - this is surely not the right way to do this...?? XXX BUGGO FIXME
# if family is internet and address is local_host, change to the local hostname
# and family_local.
#
# my (family, address)
# =
# if (address == "localhost" and
# family == family_internet
# )
# (family_local, dns_host_lookup::get_host_name());
# else
# (family, address);
# fi;
# end hack
fun strings_match ("", _) => TRUE;
strings_match (_, "") => TRUE;
strings_match (a, b) => (a == b);
end;
fun entry_is_acceptable (xt::XAUTHENTICATION { family=>f, display=>d, address=>a, ... } )
=
( # tracing added ddeboer, Jan 2005.
# (file::print ("chkAuth seeking family=" + (int::to_string (family)) + ", display="
# + display + ", address=" + address + "; examining address=" + a + ", display=" + d + "\n"));
( (family == family_wild) or
(f == family_wild) or
(family == f)
)
and strings_match (display, d)
and strings_match (address, a)
);
fun get_entry offset
=
case (extract_authentication_entry offset)
#
THE (entry, next_offset)
=>
if (entry_is_acceptable entry) THE entry;
else get_entry next_offset;
fi;
NULL => NULL;
esac;
get_entry 0;
}
except
_ = NULL;
# This is similar to get_xauthority_file_entry_by_address,
# except that a list of acceptable authentication methods
# is specified by the list acceptable_authentication_methods.
# This contains one or more strings like
#
# "MIT-MAGIC-COOKIE-1"
# "XDM-AUTHORIZATION-1"
# "SUN-DES-1"
# "MIT-KERBEROS-5"
#
# to match literally against the contents of ~/.Xauthority entries.
#
# Not all of these are available everywhere; the de facto standard
# method is MIT-MAGIC-COOKIE-1. For more information about the
# various authentication methods see (e.g.):
#
# man 7 Xsecurity
# http://manpages.ubuntu.com/manpages/jaunty/man7/Xsecurity.7.html
#
# We return the matching authentication info that matches the earliest
# name on the list.
#
# We return NULL if no match is found.
#
fun get_best_xauthority_file_entry_by_address
{
family: Int, # family_wild, family_local, family_internet ...
address: String, # From gethostname(2) or such.
display: String, # E.g. "0" -- from "localhost:0.1" DISPLAY string or such.
#
acceptable_authentication_methods: List(String) # E.g. [ "MIT-MAGIC-COOKIE-1" ]
}
=
{ extract_authentication_entry = extract_authentication_entry (read_file (get_xauthority_filename()));
# hack by ddeboer, Feb 2005 - this is surely not the right way to do this...??
# if family is internet and address is localhost, change to the local hostname
# and familyLocal.
# my (family, address)
# =
# if (address == "localhost" and # or (address=="")
# family == family_internet
# )
# (family_local, dns_host_lookup::get_host_name());
# else (family, address);
# fi;
# end hack
fun strings_match ("", _) => TRUE;
strings_match (_, "") => TRUE;
strings_match (a, b) => (a == b);
end;
fun check_auth (xt::XAUTHENTICATION { family=>f, display=>d, address=>a, ... } )
=
( ( family == family_wild or
f == family_wild or
family == f
)
and strings_match (display, d)
and strings_match (address, a)
);
fun get (offset, best_rank, best)
=
case (extract_authentication_entry offset)
#
NULL => best;
#
THE (auth as xt::XAUTHENTICATION { name, ... }, next)
=>
if (check_auth auth)
fun check_name ( [], _)
=>
get (next, best_rank, best);
check_name (n ! r, rank)
=>
if (rank < best_rank)
if (name == n) get (next, rank, THE auth);
else check_name (r, rank+1);
fi;
else get (next, best_rank, best);
fi;
end;
check_name (acceptable_authentication_methods, 0);
else
get (next, best_rank, best);
fi;
esac;
get (0, length acceptable_authentication_methods, NULL);
}
except _ = NULL;
# Read the specified authentication file
# and return a list of the entries that
# satisfy the given predicate.
#
fun get_selected_xauthority_file_entries want_entry file
=
filter (0, [])
where
extract_authentication_entry = extract_authentication_entry (read_file file);
fun filter (offset, results_so_far)
=
case (extract_authentication_entry offset)
#
NULL => reverse results_so_far;
#
THE (this_entry, next_offset)
=>
want_entry this_entry
##
?? filter (next_offset, this_entry ! results_so_far)
:: filter (next_offset, results_so_far);
esac;
end;
fun get_display_name NULL
=>
case (winix::process::get_env "DISPLAY")
#
THE display => display;
NULL => "";
esac;
get_display_name (THE display)
=>
display;
end;
# Parse an xdisplay string:
#
# "foo.com:0.0"
# ->
# { host => "foo.com",
# display => "0",
# screen => "0"
# }
#
fun parse_xdisplay_string ""
=>
{ host=>"", display=>"0", screen=>"0"};
parse_xdisplay_string d
=>
{ my (host, rest)
=
ss::split_off_prefix {. #c != ':'; } (ss::from_string d);
my (display, screen)
=
ss::split_off_prefix {. #c != '.'; } rest;
if (ss::size display < 2)
#
raise exception cxa::XSERVER_CONNECT_ERROR "No display field";
else
if (ss::size screen == 1)
#
raise exception cxa::XSERVER_CONNECT_ERROR "No screen number";
else
{ host => ss::to_string host,
display => ss::to_string (ss::drop_first 1 display),
screen => ss::to_string (ss::drop_first 1 screen)
};
fi;
fi;
};
end;
# Given an optional display name, return the
# display and authentication information.
#
# If the argument is NULL, then we use the
# DISPLAY unix environment variable if any
# else "".
#
fun get_xdisplay_string_and_xauthentication display_option
=
{ display = get_display_name display_option;
xauthentication
=
case display
#
"" => get_xauthority_file_entry_by_address
{
family => family_wild,
address => dns::get_host_name (), # Necessary to look up xrdb record -- ddeboer, 110.59.
display => "0"
};
d => { my { host, display, ... }
=
parse_xdisplay_string d;
fun make_xa family address # "xa" may be "x-window authentication (string)"
=
get_xauthority_file_entry_by_address { family, address, display };
# We must obtain the string to be used for comparison
# in get_xauthority_file_entry_by_address.
# For family_local this is the local hostname.
# For family_internet, this is the IP address as a string: "128.74.13.14" or such.
# -- ddeboer, 110.59
#
case host
#
("" | "localhost")
=>
make_xa family_local (dns::get_host_name ());
_ =>
{ address
=
# This should more properly be set to the
# peer address of the connection, *after*
# the connection has been made. However,
# that would be a bit difficult with this
# architecture. -- ddeboer 110.59
#
case (dns::get_by_name host)
#
THE entry => dns::to_string (dns::address entry);
NULL => "";
esac;
make_xa family_internet address;
};
esac;
};
esac;
(display, xauthentication);
};
}; # package xauth
end;