/pliant/fullpliant/user.page
1	module "/pliant/language/stream.pli"
2	module "/pliant/admin/md5.pli"
3	module "/pliant/util/crypto/rsa.pli"
4	module "user.pli"
5	module "this_computer.pli"
6	module "login.pli"
7	module "/pliant/language/context.pli"
8
9	requires "browse_configuration"
10
11	method page detailed_history user day_count
12	arg_rw HtmlPage page ; arg Str user ; arg Int day_count
13	var DateTime now := datetime
14	(var Stream s) open "data:/pliant/login/"+user in+safe
15	while not s:atend
16	var Str l := s readline
17	if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment))
18	var Int old := now:date:days-from:date:days
19	if old<day_count
20	s unreadline l
21	var Date day := from date
22	if day_count=1
23	[Today detailed history:]
24	else
25	fixed (text string:day)
26	text " detailed history ("+string:old+" day"+(shunt old>1 "s" "")+" ago):"
27	table columns 4
28	cell header [From]
29	cell header [To]
30	cell header [IP address]
31	cell header [comment]
32	part scan_day
33	while not s:atend
34	var Str l := s readline
35	if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment))
36	if from:date=day
37	cell text:((string from) 11 5)
38	cell text:((string to) 11 5)
39	cell (text ip)
40	cell (text comment)
41	else
42	s unreadline l
43	leave scan_day
44	var Data:User2 u :> user_database2:data:user user
45	if u:from:date=day
46	cell text:((string u:from) 11 5)
47	cell text:((string u:to) 11 5)
48	cell (text u:ip)
49	cell (text u:comment)
50
51	title "Users administration"
52
53	para
54	note "Users database client and server global settings for this computer"
55	read_only not allowed:"administrator"
56	title "This computer users database settings"
57	table columns 1
58	cell header [Users database server computers]
59	each s this_computer:env:"pliant":"password"
60	if (keyof:s parse "server" any)
61	cell
62	text s
63	table columns 1
64	cell header [Users database client computers]
65	each c this_computer:env:"pliant":"password"
66	if (keyof:c parse "client" any)
67	cell
68	text c
69	if allowed:"administrator"
70	input "Computer name: " (var Str name) noeol
71	button "Add server" noeol
72	var Int num := 1
73	while exists:(this_computer:env:"pliant":"password" "server"+string:num)
74	num += 1
75	this_computer "pliant" "password" "server"+string:num := name
76	reload_page
77	button "Remove server" noeol
78	each s this_computer:env:"pliant":"password"
79	if (keyof:s parse "server" any) and s=name
80	this_computer:env:"pliant":"password" delete keyof:s
81	reload_page
82	button "Add client" noeol
83	var Int num := 1
84	while exists:(this_computer:env:"pliant":"password" "client"+string:num)
85	num += 1
86	this_computer "pliant" "password" "client"+string:num := name
87	reload_page
88	button "Remove client"
89	each c this_computer:env:"pliant":"password"
90	if (keyof:c parse "client" any) and c=name
91	this_computer:env:"pliant":"password" delete keyof:c
92	reload_page
93	para
94	button "Broadcast all users accounts"
95	each u user
96	user_update keyof:u
97	reload_page
98	para
99	[The rule is fairly simple: when a change is applied on a user account on one of the servers, it is automatically propagated to various clients.] ; eol
100	[Changes to accounts with 'administrator' right are not propagated.]
101
102
103	[List of currently defined users:]
104
105	table columns 5
106	cell header
107	[User ID]
108	cell header
109	[First name]
110	cell header
111	[Name]
112	cell header
113	[Description]
114	cell
115	void
116	each u user
117	var Str id := keyof u
118	cell
119	text id
120	cell
121	text u:first_name
122	cell
123	text u:name
124	cell
125	text u:abstract
126	if u:homepage<>""
127	small
128	eol ; link "Homepage" u:homepage
129	cell
130	page button "Edit"
131	read_only not allowed:"administrator"
132	title "User '"+id+"'"
133	table columns 3 border 0
134	cell
135	[User ID:]
136	cell
137	fixed text:id
138	cell
139	[The string the user uses to authenticate in the computer.] ; eol
140	[An example is] ; fixed [ helene.tonneau]
141	cell
142	[First name:]
143	cell
144	input "" u:first_name
145	cell void
146	cell
147	[Name:]
148	cell
149	input "" u:name
150	cell
151	[The human readable name of the user.] ; eol
152	[An example is] ; fixed [ H鬨ne Tonneau]
153	cell
154	[Email:]
155	cell
156	input "" u:email
157	cell
158	[You may leave it blank if you prefer.]
159	cell
160	[Home page:]
161	cell
162	input "" u:homepage
163	cell
164	[You may leave it blank if you prefer.]
165	cell
166	[Contact:]
167	cell
168	text_input "" u:contact rows 5 columns 40
169	cell
170	[Other ways to contact this user (phone, fax, postal address, ...)]
171	cell
172	[Password:]
173	cell
174	if allowed:"administrator"
175	input "" (var Str password) password
176	cell
177	[In the users database, only the MD5 digest of the password is stored.]
178	cell
179	[Public key:]
180	cell
181	input "" u:public_key length 30 noeol
182	if allowed:"administrator"
183	button "Generate"
184	title "Generate a public/private key pair for '"+id+"'"
185	var Int bits := 1024
186	input "Number of bits: " bits length 4
187	input "Key password: " (var Str password) password noeol
188	button "Generate now"
189	rsa_generate "user:"+id bits password
190	goto_backward
191	para
192	[Generating a long key pair will take a very long time. ]
193	[Let's say one hour for a 1024 bits key on a 300Mhz computer. ]
194	[If the key length is double, then the consumed time will be roughly multiplyed by five.]
195	var Int bits := rsa_nbbits u:public_key
196	if bits=defined
197	small
198	eol ; [The current key is ] ; text string:bits ; [ bits wild.]
199	cell
200	[]
201	cell
202	[Language:]
203	cell
204	input "" u:language length 2
205	cell
206	[]
207	cell
208	[Options:]
209	cell
210	input "" u:options length 40
211	cell
212	[Options might be parsed by some specific applications.]
213	cell
214	[Styling options:]
215	cell
216	input "" u:style_options length 40
217	cell
218	[More options used for specifying user viewing preferences.]
219	cell
220	[Unix user ID:]
221	cell
222	input "" u:uid
223	cell
224	[]
225	cell
226	[Computer:]
227	cell
228	input "" u:computer
229	cell
230	[If you specify a Unix user ID and computer, then installed the specifyed computer with FullPliant, then a Unix user will be created.]
231	table columns 2 border 0
232	cell [Description:]
233	cell (text_input "" u:abstract rows 5 columns 60)
234
235	[The following table enables you to grant rights to the user:]
236	table columns 5
237	cell header [Line ID]
238	cell header [Authentification mechanism]
239	cell header [Client IP]
240	cell header [Computers names]
241	cell header [Granted right]
242	cell header
243	small
244	[Must be unique, but does not have any meaning.]
245	cell header
246	small
247	[The right will be granted only if the connection mecanism/protocol used by the user is at least as secured as the one specifyed here.]
248	cell header
249	small
250	[If not empty, the right will be granted only if the user is connecting from within the specifyed IP areas.] ; eol
251	note "extra details"
252	title "Client IP field"
253	[This is used to restrict the computers the user is allowed to connect from. ]
254	[As an example, you may want to specify that a use can connect from the intranet, but not from the Internet.]
255	para
256	[An axample can be:] ; fixed [ 127.0.0.1 10.30.144.0/255.255.255.0 ] ; eol
257	[and it means either 127.0.0.1 or 10.30.144.xxx IP address.]
258	cell header
259	small
260	[If not empty, the right will be granted only if connecting to one of the listed servers.] ; eol
261	note "extra details"
262	title "Server names field"
263	[You must list the real names of the server computers, not the logical names you use to access these.]
264	cell header
265	small
266	[This is the name of the right you are granting to the user. It must match the name specifyed in the 'Read' column of the web sites areas configuration.] ; eol
267	[See ] ; link "security section" "/pliant/protocol/http/" section "security" ; [ in the HTTP server documentation for predifined rights meanings.]
268	each r u:right
269	cell
270	text keyof:r
271	cell
272	select "" r:auth
273	option "None" "0"
274	option "Clear password" "1"
275	option "Chalenge password" "2"
276	option "Strong crypto" "3"
277	cell
278	input "" r:ip length 16
279	cell
280	input "" r:server length 16
281	cell
282	input "" r:right
283	if r:right="read" or r:right="write"
284	highlight "You should not use 'read' or 'write' in configuration tables."
285	if allowed:"administrator"
286	input "Line ID: " (var Str rid) length 10 noeol
287	button "Create one new line" noeol
288	u:right create rid
289	reload_page
290	button "Delete the line"
291	u:right delete rid
292	reload_page
293
294	[Add all the rights defined in some template accounts:]
295	table columns 2
296	cell header [Line ID]
297	cell header [Template account]
298	each t u:template
299	cell
300	text keyof:t
301	cell
302	input "" t length 30
303	if allowed:"administrator"
304	input "Line ID: " (var Str tid) length 10 noeol
305	button "Add a line" noeol
306	u:template create tid
307	reload_page
308	button "Remove a line"
309	u:template delete tid
310	reload_page
311
312	[The following table enables you to assign maiboxes to this user so that he can use these from Pliant web site:]
313	table columns 2
314	cell header [Line ID]
315	cell header [Mailbox]
316	each m u:mailbox
317	cell
318	text keyof:m
319	cell
320	input "" m length 30
321	if allowed:"administrator"
322	input "Line ID: " (var Str mid) length 10 noeol
323	button "Add a line" noeol
324	u:mailbox create mid
325	reload_page
326	button "Remove a line"
327	u:mailbox delete mid
328	reload_page
329
330	para
331	page button "Update user informations"
332	if password<>""
333	user_secret_database:data:user create id
334	user_secret_database:data:user:id password_md5 := string_md5_hexa_signature password
335	var CBool ok := true
336	each c this_computer:env:"pliant":"password"
337	if (keyof:c parse "client" any) and c<>computer_fullname
338	if (user_update id u:first_name u:name u:email u:abstract user_secret_database:data:user:id:password_md5 u:public_key u:language u:options u:style_options c)=failure
339	text "Failed to forward changes to server "+c ; eol
340	ok := false
341	if ok
342	goto_backward
343	para
344	var Int dc := 7
345	button "Display '"+id+"' log history" noeol
346	title (string dc)+" days history for '"+id+"' account"
347	detailed_history id dc
348	input " on " dc length 2 noeol ; [ days]
349
350	if allowed:"administrator"
351	input "User ID: " (var Str uid) noeol
352	button "Create the new user" noeol
353	user create uid
354	user_database2:data:user create uid
355	user_secret_database:data:user create uid
356	reload_page
357	page button "Delete the user"
358	var CBool ok := true
359	each c this_computer:env:"pliant":"password"
360	if (keyof:c parse "client" any) and c<>computer_fullname
361	if (user_delete uid c)=failure
362	text "Failed to delete '"+uid+"' user on server "+c ; eol
363	ok := false
364	if ok
365	user delete uid
366	user_database2:data:user delete uid
367	user_secret_database:data:user delete uid
368	reload_page
369	else
370	data_reset user_database:data:user:uid:right
371
372	para
373	input "Right: " (var Str right) noeol
374	button "Find users having this right"
375	title "List of users with '"+right+"' right"
376	table columns 4
377	cell header [User]
378	cell header [Authentification mechanism]
379	cell header [Client IP]
380	cell header [Computers names]
381	each u user
382	each r u:right
383	if r:right=right
384	read_only
385	cell (text keyof:u)
386	cell
387	select "" r:auth
388	option "None" "0"
389	option "Clear password" "1"
390	option "Chalenge password" "2"
391	option "Strong crypto" "3"
392	cell
393	input "" r:ip length 16
394	cell
395	input "" r:server length 16
396
397	if not (exists user:"anonymous")
398	para
399	[You should create an] ; fixed [ anonymous ] ; [user for defining the rights users that are not logged in are granted.] ; eol
400