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