Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/graph-util/xauth.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/graph-util/xauth.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* xauth.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * Support for X11 authentication. The authentication file, which is
6 :     * specified by the XAUTHORITY variable (default $HOME/.Xauthority),
7 :     * consists of a sequence of entries with the following format:
8 :     *
9 :     * 2 bytes Family value (second byte is as in protocol HOST)
10 :     * 2 bytes address length (always MSB first)
11 :     * A bytes host address (as in protocol HOST)
12 :     * 2 bytes display "number" length (always MSB first)
13 :     * S bytes display "number" string
14 :     * 2 bytes name length (always MSB first)
15 :     * N bytes authorization name string
16 :     * 2 bytes data length (always MSB first)
17 :     * D bytes authorization data string
18 :     *
19 :     * This implementation is partially based on code contributed by Juergen Buntrock.
20 :     *)
21 :    
22 :     structure XAuth : X_AUTH =
23 :     struct
24 :    
25 :     structure EXB = EXeneBase
26 :    
27 :     val get8 = Word8.toInt o Word8Vector.sub
28 :     (* this version of get16 handles unaligned data *)
29 :     fun get16 (s, i) = let
30 :     val s = Word8Vector.extract (s, i, SOME 2)
31 :     in
32 :     LargeWord.toInt(Pack16Big.subVec(s, 0))
33 :     end
34 :     fun getData (s, i, n) = Word8Vector.extract (s, i, SOME n)
35 :     fun getString (s, i, n) = Byte.unpackStringVec (s, i, SOME n)
36 :    
37 :     (* the different family codes (from X.h and xc/lib/Xau/Xauth.h) *)
38 :     val familyInternet = 0
39 :     val familyDECnet = 1
40 :     val familyChaos = 2
41 :     val familyLocal = 256
42 :     val familyWild = 65535
43 :    
44 :     (* return the default name of the authentication file (either
45 :     * specified by the XAUTHORITY environment variable, or the
46 :     * file $HOME/.Xauthority. If neither XAUTHORITY or HOME
47 :     * are defined, then ".Xauthority" is returned.
48 :     *)
49 :     fun authFileName () = (case (OS.Process.getEnv "XAUTHORITY")
50 :     of (SOME fname) => fname
51 :     | NONE => (case (OS.Process.getEnv "HOME")
52 :     of (SOME path) => path ^ "/.Xauthority"
53 :     | NONE => ".Xauthority"
54 :     (* end case *))
55 :     (* end case *))
56 :    
57 :     (* read the entire contents of a file *)
58 :     fun readFile file = let
59 :     val instrm = BinIO.openIn file
60 :     val contents = BinIO.inputAll instrm
61 :     in
62 :     BinIO.closeIn instrm;
63 :     contents
64 :     end
65 :    
66 :     (* extract an authentication entry from a data string *)
67 :     fun extractAuth contents = let
68 :     val len = Word8Vector.length contents
69 :     fun getLen start = get16(contents, start-2)
70 :     fun extract offset = if (offset < len)
71 :     then let
72 :     val addrStart = 4 + offset
73 :     val addrLen = getLen addrStart
74 :     val dpyStart = addrStart + addrLen + 2
75 :     val dpyLen = getLen dpyStart
76 :     val nameStart = dpyStart + dpyLen + 2
77 :     val nameLen = getLen nameStart
78 :     val dataStart = nameStart + nameLen + 2
79 :     val dataLen = getLen dataStart
80 :     val next = dataStart + dataLen
81 :     in
82 :     SOME(EXB.AUTH{
83 :     family = get16 (contents, offset),
84 :     addr = getString (contents, addrStart, addrLen),
85 :     dpy = getString (contents, dpyStart, dpyLen),
86 :     name = getString (contents, nameStart, nameLen),
87 :     data = getData (contents, dataStart, dataLen)
88 :     }, next)
89 :     end
90 :     else NONE
91 :     in
92 :     extract
93 :     end
94 :    
95 :     (* searches the default authentication file for the first entry that
96 :     * matches the family, network address and display number. If no
97 :     * such match is found, then NONE is returned. The * value familyWild
98 :     * matches anything, as do the empty strings when given for addr or dpy.
99 :     *)
100 :     fun getAuthByAddr {family, dpy, addr} = let
101 :     val extractAuth = extractAuth (readFile (authFileName()))
102 :     fun cmpStr ("", _) = true
103 :     | cmpStr (_, "") = true
104 :     | cmpStr (a, b) = (a = b)
105 :     fun chkAuth (EXB.AUTH{family=f, dpy=d, addr=a, ...}) = (
106 :     ((family = familyWild) orelse (f = familyWild) orelse (family = f))
107 :     andalso cmpStr(dpy, d)
108 :     andalso cmpStr(addr, a))
109 :     fun look offset = (case (extractAuth offset)
110 :     of NONE => NONE
111 :     | (SOME(auth, next)) =>
112 :     if (chkAuth auth) then (SOME auth) else look next
113 :     (* end case *))
114 :     in
115 :     look 0
116 :     end
117 :     handle _ => NONE
118 :    
119 :     (* this similar to getAuthByAddr, except that a list of acceptable
120 :     * authentication methods is specified by the list authNames. It
121 :     * returns the matching authentication info that matches the earliest
122 :     * name on the list. NONE is returned if no match is found.
123 :     *)
124 :     fun getBestAuthByAddr {family, addr, dpy, authNames} = let
125 :     val extractAuth = extractAuth (readFile (authFileName()))
126 :     fun cmpStr ("", _) = true
127 :     | cmpStr (_, "") = true
128 :     | cmpStr (a, b) = (a = b)
129 :     fun chkAuth (EXB.AUTH{family=f, dpy=d, addr=a, ...}) = (
130 :     ((family = familyWild) orelse (f = familyWild) orelse (family = f))
131 :     andalso cmpStr(dpy, d)
132 :     andalso cmpStr(addr, a))
133 :     fun look (offset, bestRank, best) = (case (extractAuth offset)
134 :     of NONE => best
135 :     | (SOME(auth as EXB.AUTH{name, ...}, next)) =>
136 :     if (chkAuth auth)
137 :     then let
138 :     fun chkName ([], _) = look (next, bestRank, best)
139 :     | chkName (n::r, rank) =
140 :     if (rank < bestRank)
141 :     then if (name = n)
142 :     then look (next, rank, SOME auth)
143 :     else chkName (r, rank+1)
144 :     else look (next, bestRank, best)
145 :     in
146 :     chkName (authNames, 0)
147 :     end
148 :     else look (next, bestRank, best)
149 :     (* end case *))
150 :     in
151 :     look (0, length authNames, NONE)
152 :     end
153 :     handle _ => NONE
154 :    
155 :     (* read the specified authentication file and return a list of
156 :     * entries that satisfy the given predicate.
157 :     *)
158 :     fun readAuthFile checkAuth file = let
159 :     val extractAuth = extractAuth (readFile file)
160 :     fun filter (offset, l) = (case (extractAuth offset)
161 :     of NONE => rev l
162 :     | (SOME(auth, next)) => if (checkAuth auth)
163 :     then filter (next, auth::l)
164 :     else filter (next, l)
165 :     (* end case *))
166 :     in
167 :     filter (0, [])
168 :     end
169 :    
170 :     end;
171 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0