1#!%TCLSH%
2
3#
4# Mail roles
5#
6# Parameters (form or url): none
7#   - display selection page
8#	- action : (empty)
9#   - list existing mail addresses
10#	- action : "list"
11#	- domain : domain (last components of fqdn) of mail address
12#	- idview: id of selected view
13#   - add mail role
14#	- action: "add"
15#	- name : name (first component of fqdn) of mail address
16#	- domain : domain (last components of fqdn) of mail address
17#	- idview: view id of mail address
18#	- namem : name (first component of fqdn) of mailbox host
19#	- domainm : domain (last components of fqdn) of mailbox host
20#	- idviewm: view id of mailbox host
21#   - display mail host for a mail address
22#	- action : "edit"
23#	- name : name (first component of fqdn) of mail address (or empty)
24#	- domain : domain (last components of fqdn) of mail address
25#	- idview: id of selected view, or empty if no view has been selected
26#   - modify mail host for a mail address
27#	- action : "mod"
28#	- name : name (first component of fqdn) of mail address
29#	- domain : domain (last components of fqdn) of mail address
30#	- namem : name (first component of fqdn) of mailbox host
31#	- domainm : domain (last components of fqdn) of mailbox host
32#
33# History
34#   2004/02/06 : pda/jean : design
35#   2007/10/25 : jean     : log modify actions
36#   2010/12/13 : pda      : i18n
37#   2010/12/25 : pda      : use cgi-dispatch
38#
39
40#
41# Template pages used by this script
42#
43
44set conf(page-sel)	mail-sel.html
45set conf(page-list)	mail-list.html
46set conf(page-view)	mail-view.html
47set conf(page-edit)	mail-edit.html
48set conf(page-mod)	mail-mod.html
49
50#
51# Next actions
52#
53
54set conf(next)		"mail"
55
56#
57# Tabular format
58# Columns :
59#	- mail address
60#	- mail host
61#
62
63set conf(tableau) {
64    global {
65	chars {12 normal}
66	columns {50 50}
67	botbar {yes}
68	align {left}
69    }
70    pattern Title {
71	title {yes}
72	topbar {yes}
73	chars {bold}
74	align {center}
75	vbar {yes}
76	column { }
77	vbar {yes}
78	column { }
79	vbar {yes}
80    }
81    pattern Normal {
82	title {yes}
83	topbar {yes}
84	vbar {yes}
85	column {
86	    format {raw}
87	}
88	vbar {yes}
89	column { }
90	vbar {yes}
91    }
92}
93
94#
95# Netmagis general library
96#
97
98source %LIBNETMAGIS%
99
100# ::webapp::cgidebug ; exit
101
102##############################################################################
103# Display page to select a mail address or to list all mail roles
104##############################################################################
105
106d cgi-register {action {}} {
107} {
108    global conf
109
110    #
111    # Extract domains where user can declare "mail roles"
112    #
113
114    set w "p_dom.mailrole <> 0"
115    set domain [menu-domain $dbfd $tabuid(idcor) "domain" $w ""]
116
117    #
118    # Extract domains where user can have mailbox hosts
119    #
120
121    set domainm [menu-domain $dbfd $tabuid(idcor) "domainm" "" ""]
122
123    #
124    # View menus
125    #
126
127    set menuview [mc "View"]
128    append menuview " "
129    lassign [menu-view $dbfd $tabuid(idcor) "idview" {}] disp html
130    append menuview $html
131    if {$disp} then {
132	set dispview "inline"
133    } else {
134	set dispview "none"
135    }
136
137    set menuviewm [mc "View"]
138    append menuviewm " "
139    lassign [menu-view $dbfd $tabuid(idcor) "idviewm" {}] disp html
140    append menuviewm $html
141
142    #
143    # End of script: output page and close database
144    #
145
146    d urlset "%URLFORM%" $conf(next) {}
147    d result $conf(page-sel) [list \
148				[list %DOMAIN%   $domain] \
149				[list %DOMAINM%  $domainm] \
150				[list %DISPVIEW% $dispview] \
151				[list %MENUVIEW% $menuview] \
152				[list %MENUVIEWM% $menuviewm] \
153			    ]
154}
155
156##############################################################################
157# List mail roles
158##############################################################################
159
160d cgi-register {action list} {
161    {domain	1 1}
162    {idview	1 1}
163} {
164    global conf
165
166    set idcor $tabuid(idcor)
167
168    #
169    # Do we have permission for declaring mail roles in this domain?
170    #
171
172    set iddom -1
173    set msg [check-domain $dbfd $idcor iddom domain "mailrole"]
174    if {$msg ne ""} then {
175	d error $msg
176    }
177
178    #
179    # Check view
180    #
181
182    set msg [check-views [list $idview]]
183    if {$msg ne ""} then {
184	d error $msg
185    }
186
187    #
188    # Get mail roles
189    #
190
191    set sql "
192	SELECT r1.name AS namea, d1.name AS domaina,
193		r2.name AS namem, d2.name AS domainm, v2.name AS viewnamem
194	    FROM dns.mail_role, global.nmuser,
195		dns.rr r1, dns.domain d1, dns.rr r2, dns.domain d2,
196		dns.view v2
197	    WHERE nmuser.idcor = $idcor
198		AND mail_role.mailaddr = r1.idrr
199		AND r1.iddom = d1.iddom
200		AND d1.name = '$domain'
201		AND r1.iddom =
202			(SELECT p1.iddom FROM dns.p_dom p1
203					WHERE p1.idgrp = nmuser.idgrp
204					    AND p1.iddom = r1.iddom
205					    AND p1.mailrole > 0
206			    )
207		AND mail_role.mboxhost = r2.idrr
208		AND r2.iddom = d2.iddom
209		AND r2.iddom =
210			(SELECT p2.iddom FROM dns.p_dom p2
211					WHERE p2.idgrp = nmuser.idgrp
212					    AND p2.iddom = r2.iddom
213			    )
214		AND r2.idrr IN
215			(SELECT r3.idrr FROM dns.rr_ip r3
216					WHERE dns.check_ip_cor(addr, $idcor)
217					    AND r3.idrr = r2.idrr
218			    )
219		AND r2.idrr NOT IN
220			(SELECT r4.idrr FROM dns.rr_ip r4
221					WHERE NOT dns.check_ip_cor(addr, $idcor)
222					    AND r4.idrr = r2.idrr
223			    )
224		AND r1.idview = $idview
225		AND r2.idview = v2.idview
226		AND r2.idview IN
227			(SELECT idview FROM dns.p_view pv
228					WHERE pv.idgrp = nmuser.idgrp)
229	    ORDER BY domaina ASC, namea ASC
230		"
231    set lroles {}
232    pg_select $dbfd $sql tab {
233	lappend lroles [list $tab(namea) $tab(domaina) \
234				$tab(namem) $tab(domainm) $tab(viewnamem)]
235    }
236
237    if {[llength $lroles] == 0} then {
238	set tableau [mc "No mail role found for '%s'" $domain]
239    } else {
240	set lines {}
241	lappend lines [list "Title" \
242				[mc "Mail address"]  \
243				[mc "Mailbox host"]  \
244			    ]
245	foreach q $lroles {
246	    # link "..../mail?action=edit&name=...&domain=...&idview=..."
247	    lassign $q namea domaina namem domainm viewnamem
248
249	    # only "RFC compatible" characters, no need to quote
250	    d urlset "" $conf(next) [list \
251						[list "action" "edit"] \
252						[list "name" $namea] \
253						[list "domain" $domaina] \
254						[list "idview" $idview] \
255					]
256	    set url [d urlget ""]
257	    set html [::webapp::helem "a" "$namea.$domaina" "href" $url]
258
259	    lappend lines [list Normal $html "$namem.$domainm/$viewnamem"]
260	}
261	set tableau [::arrgen::output "html" $conf(tableau) $lines]
262    }
263
264    #
265    # End of script: output page and close database
266    #
267
268    d result $conf(page-list) [list \
269				    [list %TABLEAU% $tableau] \
270				    [list %DOMAIN% $domain] \
271				]
272}
273
274##############################################################################
275# Add mail role
276##############################################################################
277
278d cgi-register {action add} {
279    {name	1 1}
280    {domain	1 1}
281    {idview	1 1}
282    {namem	1 1}
283    {domainm	1 1}
284    {idviewm	1 1}
285} {
286    global conf
287
288    set idcor $tabuid(idcor)
289
290    set name    [string trim [lindex $ftab(name) 0]]
291    set domain  [string trim [lindex $ftab(domain) 0]]
292    set namem   [string trim [lindex $ftab(namem) 0]]
293    set domainm [string trim [lindex $ftab(domainm) 0]]
294
295    set fqdn "$name.$domain"
296    set fqdnm "$namem.$domainm"
297
298    #
299    # Check view ids
300    #
301
302    foreach v {idview idviewm} {
303	set msg [check-views [list [set $v]]]
304	if {$msg ne ""} then {
305	    d error $msg
306	}
307    }
308    set vn  [u viewname $idview]
309    set vnm [u viewname $idviewm]
310
311    #
312    # Check permission to declare a mail role
313    #
314
315    set msg [check-authorized-host $dbfd $idcor $name $domain $idview trr "add-mailaddr"]
316
317    if {$msg ne ""} then {
318	d error $msg
319    }
320
321    #
322    # Check future mailbox host
323    #
324
325    set msg [check-authorized-host $dbfd $idcor $namem $domainm $idviewm trrm "existing-host"]
326    if {$msg ne ""} then {
327	d error $msg
328    }
329
330    #
331    # Add the mail role
332    #
333
334    d dblock {dns.rr dns.mail_role}
335
336    set action [mc "created"]
337
338    if {$trr(idrr) eq ""} then {
339	#
340	# Name of mail address does not exist. Add appropriate RR.
341	#
342	set msg [add-rr $dbfd $name $trr(iddom) $idview "" 0 "" 0 -1 "" "" "" $idcor trr]
343	if {$msg ne ""} then {
344	    d dbabort [mc "add %s" $name] $msg
345	}
346    }
347
348    set sql "INSERT INTO dns.mail_role (mailaddr, mboxhost)
349				VALUES ($trr(idrr), $trrm(idrr))"
350    if {! [::pgsql::execsql $dbfd $sql msg]} then {
351	d dbabort [mc "add %s" [mc "mail role"]] $msg
352    }
353
354    #
355    # We did not had any error while modifying database.
356    # Finish transaction.
357    #
358
359    d dbcommit [mc "modify %s" [mc "mail role"]]
360    d writelog "modmailrole" "add mail role $fqdn/$vn -> $fqdnm/$vnm"
361
362    #
363    # End of script: output page and close database
364    #
365
366    d result $conf(page-mod) [list \
367				[list %NAME% $fqdn] \
368				[list %ACTION% $action] \
369			    ]
370}
371
372##############################################################################
373# Select mail host
374##############################################################################
375
376#
377# host found in only one view (or selected view): display host edition page
378#
379
380proc disp-edit {dbfd _chkv _tabuid} {
381    global conf
382    upvar $_chkv chkv
383    upvar $_tabuid tabuid
384
385    #
386    # Get id of found view
387    #
388
389    set idview [lindex $chkv(ok) 0]
390    lassign $chkv($idview) vn msg t
391    array set trr $t
392
393    set viewname [::webapp::html-string $vn]
394
395    #
396    # In order to display mail address
397    #
398
399    set name $trr(name)
400    set domain $trr(domain)
401
402    #
403    # Get RR of existing mailbox host
404    #
405
406    set rm [rr-mailrole-by-view trr $idview]
407    lassign $rm idrr idviewm
408
409    if {! [read-rr-by-id $dbfd $idrr trrm]} then {
410	d error [mc "Internal error: id '%s' doesn't exists for a mail host" $idrr]
411    }
412
413    set namem $trrm(name)
414    set domm $trrm(domain)
415    set domainm [menu-domain $dbfd $tabuid(idcor) "domainm" "" $domm]
416
417    set m [menu-view $dbfd $tabuid(idcor) "idviewm" [list $idviewm]]
418    lassign $m disp viewval
419    if {$disp} then {
420	set viewlibelle [mc "View"]
421    } else {
422	set viewlibelle ""
423    }
424
425    #
426    # End of script: output page and close database
427    #
428
429    d result $conf(page-edit) [list \
430				    [list %NAME%      $name] \
431				    [list %DOMAIN%    $domain] \
432				    [list %IDVIEW%    $idview] \
433				    [list %VIEWNAME%  $viewname] \
434				    [list %NAMEM%     $namem] \
435				    [list %DOMAINM%   $domainm] \
436				    [list %VIEWLIBELLEM% $viewlibelle] \
437				    [list %VIEWVALM%  $viewval] \
438				]
439}
440
441
442d cgi-register {action edit} {
443    {name	1 1}
444    {domain	1 1}
445    {idview	0 1}
446} {
447    global conf
448
449    set idcor $tabuid(idcor)
450
451    #
452    # Do we have permission for declaring mail roles in this domain?
453    #
454
455    set iddom -1
456    set msg [check-domain $dbfd $idcor iddom domain "mailrole"]
457    if {$msg ne ""} then {
458	d error $msg
459    }
460
461    set namem ""
462    set domm ""
463
464    #
465    # Check mail address syntax
466    #
467
468    set msg [check-name-syntax $name]
469    if {$msg ne ""} then {
470	d error $msg
471    }
472
473    #
474    # Do we have permission for this mail role (may be in this particular view)
475    #
476
477    set fqdn "$name.$domain"
478    if {$idview eq ""} then {
479	set idviews {}
480    } else {
481	set idviews [list $idview]
482    }
483
484    set msg [filter-views $dbfd tabuid "mailrole" $fqdn $idviews chkv]
485    if {$msg ne ""} then {
486	d error $msg
487    }
488
489    #
490    # If only one view is found to be correct, go directly to the
491    # modify form
492    #
493
494    if {[llength $chkv(ok)] == 1} then {
495	disp-edit $dbfd chkv tabuid
496    } else {
497	set html [html-select-view chkv $conf(next)]
498	d result $conf(page-view) [list \
499					[list %LIST% $html] \
500				]
501    }
502}
503
504##############################################################################
505# Modify mail host
506##############################################################################
507
508d cgi-register {action mod} {
509    {name	1 1}
510    {domain	1 1}
511    {idview	1 1}
512    {namem	1 1}
513    {domainm	1 1}
514    {idviewm	1 1}
515} {
516    global conf
517
518    set idcor $tabuid(idcor)
519
520    set name    [string trim [lindex $ftab(name) 0]]
521    set domain  [string trim [lindex $ftab(domain) 0]]
522    set namem   [string trim [lindex $ftab(namem) 0]]
523    set domainm [string trim [lindex $ftab(domainm) 0]]
524
525    set fqdn "$name.$domain"
526    set fqdnm "$namem.$domainm"
527
528    #
529    # Do we have permission for this mail role
530    #
531
532    set msg [filter-views $dbfd tabuid "mailrole" $fqdn [list $idview] chkv]
533    if {$msg ne ""} then {
534	d error $msg
535    }
536    if {[llength $chkv(ok)] != 1} then {
537	d error "Internal error"
538    }
539
540    set idv [lindex $chkv(ok) 0]
541    lassign $chkv($idv) vn msg t
542    array set trr $t
543    set idrr $trr(idrr)
544
545    #
546    # Check new mailbox host
547    #
548
549    if {$namem ne ""} then {
550	set msg [check-authorized-host $dbfd $tabuid(idcor) $namem $domainm $idviewm trrm "existing-host"]
551	if {$msg ne ""} then {
552	    d error $msg
553	}
554    }
555
556    #
557    # Insert data in database: if namem is empty, it is a removal,
558    # else it is a modification.
559    #
560
561    d dblock {dns.rr dns.mail_role}
562
563    if {$namem eq ""} then {
564	#
565	# Mail role removal
566	#
567
568	set action [mc "deleted"]
569
570	set msg [del-mailrole-by-id $dbfd $idrr]
571	if {$msg ne ""} then {
572	    d dbabort [mc "delete %s" [mc "mail role"]] $msg
573	}
574
575	#
576	# RR removal (if possible)
577	#
578	set msg [del-orphaned-rr $dbfd $idrr]
579	if {$msg ne ""} then {
580	    d dbabort [mc "delete %s" [mc "RR"]] $msg
581	}
582
583	set lm "delete mail role $fqdn"
584    } else {
585	#
586	# Mail role modification
587	#
588
589	set action [mc "modified"]
590
591	set sql "UPDATE dns.mail_role
592			    SET mboxhost = $trrm(idrr)
593			    FROM dns.rr
594			    WHERE mail_role.mailaddr = rr.idrr
595				AND rr.idrr = $idrr
596				AND rr.idview = $idview"
597	if {! [::pgsql::execsql $dbfd $sql msg]} then {
598	    d dbabort [mc "modify %s" [mc "mail role"]] $msg
599	}
600	set lm "modify mail role $fqdn -> $fqdnm"
601    }
602
603    #
604    # We did not had any error while modifying database.
605    # Finish transaction.
606    #
607
608    d dbcommit [mc "modify %s" [mc "mail role"]]
609    d writelog "modmailrole" $lm
610
611    #
612    # End of script: output page and close database
613    #
614
615    d result $conf(page-mod) [list \
616				[list %NAME% $fqdn] \
617				[list %ACTION% $action] \
618			    ]
619}
620
621##############################################################################
622# Main procedure
623##############################################################################
624
625d cgi-dispatch "dns" ""
626