/pliant/protocol/dns/name.page
 
 1  module "/pliant/language/unsafe.pli" 
 2  module "name.pli" 
 3  module "/pliant/protocol/dns/client.pli" 
 4  module "/pliant/protocol/http/site.pli" 
 5  module "/pliant/fullpliant/this_computer.pli" 
 6  module "/pliant/util/crypto/rsa.pli" 
 7  # module "/pliant/fullpliant/computer.pli" 
 8   
 9  function ip_sort ip -> s 
 10    arg Str ip s 
 11    if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) any) 
 12      := (right string:i1 "0")+"."+(right string:i2 "0")+"."+(right string:i3 "0")+"."+(right string:i4 "0") 
 13    else 
 14      := ip 
 15   
 16  requires "browse_configuration" 
 17   
 18  read_only not allowed:"administrator" 
 19   
 20  title "Names administration" 
 21   
 22  note "DNS client and server global settings for this computer" 
 23    read_only not allowed:"administrator" 
 24    title "This computer DNS settings" 
 25    table columns 3 border 0 
 26      cell [DNS service:] 
 27      cell 
 28        var Str dns := this_computer:env:"pliant":"dns":"service" 
 29        select "" dns 
 30          option "" "" 
 31          option "Yes" "true" 
 32          option "No" "false" 
 33      cell [Should we run the DNS server on this computer ?] 
 34      cell [DNS providers:] 
 35      cell 
 36        var Str provider1 := this_computer:env:"pliant":"dns":"provider1" 
 37        input "" provider1 noeol 
 38        if provider1<>"" 
 39          var DateTime start := datetime 
 40          var Str answer := dns_query "www.debian.org" 1 provider1 5 
 41          var DateTime stop := datetime 
 42          small 
 43            text (shunt answer<>"" "ok" "broken")+" in "+(string 1000*(stop:seconds-start:seconds) "fixed 0")+" ms" 
 44        eol 
 45        var Str provider2 := this_computer:env:"pliant":"dns":"provider2" 
 46        input "" provider2 noeol 
 47        if provider2<>"" 
 48          var DateTime start := datetime 
 49          var Str answer := dns_query "www.debian.org" 1 provider2 5 
 50          var DateTime stop := datetime 
 51          small 
 52            text (shunt answer<>"" "ok" "broken")+" in "+(string 1000*(stop:seconds-start:seconds) "fixed 0")+" ms" 
 53        eol 
 54      cell [IP addresses of external DNS we should forward queries to when the request does not apply to a local domain (I mean when the Pliant DNS server behaves as a cache).] 
 55      cell [DNS cache:] 
 56      cell 
 57        var Str cache := this_computer:env:"pliant":"dns":"cache" 
 58        input "" cache  
 59      cell 
 60        [For what IPs should the Pliant DNS server behaves as a DNS cache. Might be something like:] 
 61        fixed [ 10.0.0.0/255.0.0.0 127.0.0.1] 
 62      cell [Default domain:] 
 63      cell 
 64        var Str default := this_computer:env:"pliant":"dns":"default" 
 65        input "" default 
 66      cell 
 67        [What domain (such as 'mycrop.com') should be added when a client requests a simple name (like 'foo' as opposed to 'foo.mycrop.com').] ; eol 
 68        [Applies only for local queries, local meaning in the selected subsets of IP addresses defined in 'DNS cache' field.] 
 69    if allowed:"administrator" 
 70      button "Update" 
 71        this_computer "pliant" "dns" "service" := dns 
 72        if provider1<>"" 
 73          this_computer "pliant" "dns" "provider1" := provider1 
 74        else 
 75          this_computer:env:"pliant":"dns" delete "provider1" 
 76        if provider2<>"" 
 77          this_computer "pliant" "dns" "provider2" := provider2 
 78        else 
 79          this_computer:env:"pliant":"dns" delete "provider2" 
 80        this_computer "pliant" "dns" "cache" := cache 
 81        this_computer "pliant" "dns" "default" := default 
 82        goto_backward 
 83  eol 
 84  page note "Compute IP reverse mapping" 
 85    title "IP reverse mapping" 
 86    var (Index Str Str) ips 
 87    each name_database:data:name 
 88      if (n:ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4)) 
 89        ips insert (ip_sort n:ip) keyof:n 
 90    each name_database:data:host 
 91      if (h:ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4)) 
 92        ips insert (ip_sort h:ip) keyof:h 
 93      var Int := 0 
 94      while ((h:options option "ip" Str) parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) any) 
 95        ips insert (ip_sort (h:options option "ip" Str)) keyof:h 
 96        += 1 
 97    if false 
 98      each c computer_database:data:computer 
 99        each d c:env:"net_device" 
 100          if (d:"ip" parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4)) 
 101            ips insert (ip_sort d:"ip") keyof:c 
 102    table columns 2 
 103      cell header [IP] 
 104      cell header [name] 
 105      each ip ips 
 106        cell 
 107          if ((ips key ip) parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4)) 
 108            text string:i1+"."+string:i2+"."+string:i3+"."+string:i4 
 109          else 
 110            text (ips key ip) 
 111        cell 
 112          text ip    
 113   
 114   
 115  header "Names" 
 116   
 117  [List of currently defined names:] 
 118  table columns 3 
 119    cell header 
 120      [Name] 
 121    cell header 
 122      [IP] 
 123    cell void 
 124    each name_database:data:name 
 125      cell 
 126        fixed (text keyof:n) 
 127      cell 
 128        text n:ip ; eol 
 129        if n:ip<>(name_ip n:ip) 
 130          font color (color hsl 0 0 50) 
 131            fixed text:(name_ip n:ip) 
 132      cell 
 133        if allowed:"administrator" 
 134          button "edit" 
 135            title "'"+keyof:n+"' name" 
 136            table columns 2 
 137              cell 
 138                [IP:] 
 139              cell 
 140                input "" n:ip 
 141              cell 
 142                [Options:] 
 143              cell 
 144                input "" n:options length 60 
 145              cell 
 146                [Comment:] 
 147              cell 
 148                text_input "" n:comment columns 60 rows 10 
 149            button "Update" 
 150              goto_backward    
 151   
 152  if allowed:"administrator" 
 153    input "Name: " (var Str nid) length 30 noeol 
 154    input " IP: " (var Str nip) length 16 noeol 
 155    button "Create the new name" noeol 
 156      name_database:data:name create nid 
 157      name_database:data:name:nid ip := nip 
 158      reload_page 
 159    button "Delete the name" 
 160      name_database:data:name delete nid 
 161      reload_page 
 162   
 163   
 164  header "Hosts" 
 165   
 166  [List of currently defined hosts:] 
 167  table columns 3 
 168    cell header [Host] 
 169    cell header [IP] 
 170    cell void 
 171    each name_database:data:host 
 172      var Str id := keyof h 
 173      cell 
 174        fixed text:id 
 175      cell 
 176        if h:ip<>"" 
 177          fixed (text h:ip) 
 178        eif h:physical<>"" 
 179          font color (color hsl 0 0 50) 
 180            fixed text:(name_ip h:physical) 
 181      cell 
 182        button "edit" 
 183          read_only not allowed:"administrator" 
 184          title "'"+keyof:h+"' host" 
 185          table columns 2 
 186            cell 
 187              [Public key:] 
 188            cell 
 189              if allowed:"administrator" 
 190                input "" h:public_key length 30 noeol 
 191                page button "Generate" 
 192                  title "Generate a public/private key pair for '"+id+"'" 
 193                  var Int bits := 1024 
 194                  input "Number of bits: " bits length 4 noeol 
 195                  button "Generate now" 
 196                    var DateTime start := datetime 
 197                    rsa_generate "host:"+id bits "" 
 198                    console "generated a " bits " bits key in " datetime:seconds-start:seconds " seconds." eol 
 199                    goto_backward 
 200              var Int bits := rsa_nbbits h:public_key 
 201              if bits=defined 
 202                if name_secret_database:data:host:id:private_key<>"" 
 203                  bold 
 204                    text string:bits+" bits" 
 205                  if (name_secret_database:data:host:id:private_key parse word:"rsa" _ any:(var Str part1a) _ any) and (h:public_key parse word:"rsa" _ any:(var Str part1b) _ any) and part1a<>part1b 
 206                    fixed [  ] ; highlight "key is corrupted !" 
 207                else 
 208                  font color (color hsl 0 0 50) 
 209                    text string:bits+" bits" 
 210            cell 
 211              [Building:] 
 212            cell 
 213              input " " h:building length 30 
 214            cell 
 215              [Physical server name:] 
 216            cell 
 217              input "" h:physical length 30 
 218            cell 
 219              [IP address:] 
 220            cell 
 221              input " " h:ip length 16 
 222            cell 
 223              [TCP ports:] 
 224            cell 
 225              input "Multiplexer: " h:port length 5 noeol 
 226              input "HTTP: " h:http_port length 5 noeol 
 227              input " Remote execution: " h:remote_port length 5 
 228            cell 
 229              [Options:] 
 230            cell 
 231              input "" h:options length 60 
 232            if allowed:"administrator" 
 233              cell 
 234                [Comment:] 
 235              cell 
 236                text_input "" h:comment columns 60 rows 10 
 237          if allowed:"administrator" 
 238            button "Update" 
 239              goto_backward    
 240   
 241  if allowed:"administrator" 
 242    input "Host: " (var Str hid) length 30 noeol 
 243    button "Create the new host" noeol 
 244      name_database:data:host create hid 
 245      reload_page 
 246    button "Delete the host" 
 247      name_database:data:host delete hid 
 248      name_secret_database:data:host delete hid 
 249      reload_page 
 250   
 251   
 252  header "Buildings" 
 253   
 254  [List of currently defined buildings:] 
 255  table columns 2 
 256    cell header 
 257      [ID] 
 258    cell void 
 259    each name_database:data:building 
 260      cell 
 261        fixed (text keyof:b) 
 262      cell 
 263        if allowed:"administrator" 
 264          page button "edit" 
 265            title "'"+keyof:b+"' building" 
 266            table columns 2 
 267              cell 
 268                [Proxys:] 
 269              cell 
 270                table columns 2 border 0 
 271                  each proxy b:proxy 
 272                    cell 
 273                      text keyof:proxy 
 274                    cell 
 275                      text proxy 
 276              cell 
 277                [Options:] 
 278              cell 
 279                input "" b:options length 60 
 280              cell 
 281                [Comment:] 
 282              cell 
 283                text_input "" b:comment columns 60 rows 10 
 284            input "Proxy line ID: " (var Str pid) length 2 noeol 
 285            input " and name: " (var Str pname) length 30 noeol 
 286            button "Record proxy" noeol 
 287              b:proxy create pid 
 288              b:proxy pid := pname 
 289              reload_page 
 290            button "Remove proxy" 
 291              b:proxy delete pid 
 292              reload_page 
 293            button "Update" 
 294              goto_backward    
 295   
 296  if allowed:"administrator" 
 297    input "Name: " (var Str bid) length 30 noeol 
 298    button "Create the new building" noeol 
 299      name_database:data:building create bid 
 300      reload_page 
 301    button "Delete the building" 
 302      name_database:data:building delete bid 
 303      reload_page 
 304   
 305   
 306  header "Web sites" 
 307   
 308    [Theses are the ] 
 309    link "web sites definitions" "/pliant/protocol/http/site.html" 
 310    [ providing name resolution possibility:] 
 311    eol 
 312    table columns 2 
 313      cell header [Site] 
 314      cell header [IP] 
 315      each site 
 316        if s:ip<>"" or s:computer<>"" 
 317          cell 
 318            fixed (text keyof:s) 
 319          cell 
 320            if s:ip<>"" 
 321              fixed (text s:ip) 
 322            eif s:computer<>"" 
 323              font color (color hsl 0 0 50) 
 324                fixed text:(name_ip s:computer) 
 325   
 326   
 327  header "Domains" 
 328   
 329  [List of currently defined domains:] 
 330  table columns 4 
 331    cell header 
 332      [Domain] 
 333    cell header 
 334      [DNS servers] 
 335    cell header 
 336      [Mail servers] 
 337    cell void 
 338    each name_database:data:domain 
 339      cell 
 340        fixed (text keyof:d) 
 341      cell 
 342        small 
 343          each c_dns d:dns 
 344            text c_dns ; eol 
 345      cell 
 346        small 
 347          each c_mail d:mail 
 348            text c_mail ; eol 
 349      cell 
 350        button "Edit" 
 351          read_only not allowed:"administrator" 
 352          title "Domain '"+keyof:d+"'" 
 353          table columns 3 border 0 
 354            cell [Administrator mailbox:] 
 355            cell (input "" d:mailbox) 
 356            cell void 
 357            cell [Pliant DNS is authoritative for the domain:] 
 358            cell 
 359              select "" d:authoritative 
 360                option "yes" "true" 
 361                option "no" "false" 
 362            cell [Set this to no if the domain is not handled by this DNS server.] 
 363          para 
 364            [DNS servers:] 
 365            table columns 2 
 366              cell header 
 367                [Line ID] 
 368              cell header 
 369                [Name] 
 370              each dns d:dns 
 371                cell 
 372                  fixed (text keyof:dns) ; eol 
 373                cell 
 374                  input "" dns 
 375                  if name_ip:dns<>"" 
 376                    font color (color hsl 0 0 50) 
 377                      fixed (text name_ip:dns) 
 378            if allowed:"administrator" 
 379              input "Line ID: " (var Str did) length 8 noeol 
 380              button "Create the new line" noeol 
 381                d:dns create did 
 382                reload_page 
 383              button "Delete the line" 
 384                d:dns delete did 
 385                reload_page 
 386          para 
 387            [Mail servers:] 
 388            table columns 2 
 389              cell header 
 390                [Line ID] 
 391              cell header 
 392                [Name] 
 393              each mail d:mail 
 394                cell 
 395                  fixed (text keyof:mail) ; eol 
 396                cell 
 397                  input "" mail 
 398                  if name_ip:mail<>"" 
 399                    font color (color hsl 0 0 50) 
 400                      fixed (text name_ip:mail) 
 401            if allowed:"administrator" 
 402              input "Line ID: " (var Str mid) length 8 noeol 
 403              button "Create the new line" noeol 
 404                d:mail create mid 
 405                reload_page 
 406              button "Delete the line" 
 407                d:mail delete mid 
 408                reload_page 
 409          if allowed:"administrator" 
 410            button "Update" 
 411              goto_backward 
 412   
 413  if allowed:"administrator" 
 414    input "Domain: " (var Str did) length 20 noeol 
 415    button "Create the new domain" noeol 
 416      name_database:data:domain create did 
 417      reload_page 
 418    button "Delete the domain" 
 419      name_database:data:domain delete did 
 420      reload_page 
 421   
 422   
 423  header "IP masks" 
 424   
 425  [List of currently defined IP masks:] 
 426  table columns 3 
 427    cell header 
 428      [IP] 
 429    cell header 
 430      [Mask] 
 431    cell void 
 432    each name_database:data:mask 
 433      cell 
 434        fixed (text keyof:m) ; eol 
 435      cell 
 436        text m 
 437      cell 
 438        if allowed:"administrator" 
 439          button "edit" 
 440            title "'"+keyof:m+"' IP pool" 
 441            table columns 2 
 442              cell 
 443                [Mask:] 
 444              cell 
 445                input "" m 
 446            button "Update" 
 447              goto_backward 
 448   
 449  if allowed:"administrator" 
 450    input "IP: " (var Str mid) length 12 noeol 
 451    button "Create the new IP mask" noeol 
 452      name_database:data:mask create mid 
 453      reload_page 
 454    button "Delete the IP mask" 
 455      name_database:data:mask delete mid 
 456      reload_page 
 457   
 458   
 459  header "Reverse names" 
 460   
 461  [List of currently defined reverse names:] 
 462  table columns 3 
 463    cell header 
 464      [IP] 
 465    cell header 
 466      [Names] 
 467    cell void 
 468    each name_database:data:reverse 
 469      cell 
 470        fixed (text keyof:r) ; eol 
 471      cell 
 472        small 
 473          each c_ptr r:ptr 
 474            text c_ptr ; eol 
 475      cell 
 476        if allowed:"administrator" 
 477          button "Edit" 
 478            title "Reverse DNS for '"+keyof:r+"'" 
 479            [Names:] 
 480            table columns 2 
 481              cell header 
 482                [Line ID] 
 483              cell header 
 484                [Name] 
 485              each ptr r:ptr 
 486                cell 
 487                  fixed (text keyof:ptr) ; eol 
 488                cell 
 489                  input "" ptr 
 490                  if name_ip:ptr<>"" 
 491                    font color (color hsl 0 0 50) 
 492                      fixed (text name_ip:ptr) 
 493            input "Line ID: " (var Str pid) length 30 noeol 
 494            button "Create the new line" noeol 
 495              r:ptr create pid 
 496              reload_page 
 497            button "Delete the line" 
 498              r:ptr delete pid 
 499              reload_page 
 500            button "Auto fill" noeol 
 501              var Str all := keyof r ; var Str ip 
 502              while all<>"" 
 503                if not (all parse any:(var Str first) "." any:(var Str remain)) 
 504                  first := all ; remain := "" 
 505                if (first parse (var Int i)) 
 506                  ip := string:i+(shunt ip<>"" "." "")+ip 
 507                all := remain 
 508              data_reset r:ptr 
 509              var Int := 1 
 510              each name_database:data:name 
 511                if n:ip=ip 
 512                  r:ptr create string:u 
 513                  r:ptr string::= keyof n 
 514                  += 1 
 515              reload_page 
 516            button "Update" 
 517              goto_backward 
 518   
 519  if allowed:"administrator" 
 520    input "Reverse entry: " (var Str rid) length 30 noeol 
 521    button "Create the new reverse entry" noeol 
 522      name_database:data:reverse create rid 
 523      reload_page 
 524    button "Delete the reverse entry" 
 525      name_database:data:reverse delete rid 
 526      reload_page 
 527   
 528   
 529  if allowed:"administrator" 
 530    header "Actions" 
 531     
 532    button "Now record changes" 
 533      goto_backward 
 534   
 535    var CBool migrate := false 
 536    each name_database:data:name 
 537      if (exists name_database:data:host:(keyof n)) 
 538        migrate := true 
 539    if migrate 
 540      para 
 541        page button "Drop no use hosts IPs" noeol 
 542          each name_database:data:name 
 543            if (exists name_database:data:host:(keyof n)) 
 544              name_database:data:host:(keyof n) ip := ip 
 545              name_database:data:name delete keyof:n 
 546          reload_page 
 547   
 548    var CBool migrate := false 
 549    each name_database:data:name 
 550      if (name_ip site_database:data:site:(keyof n):computer)=(name_ip n:ip) 
 551        migrate := true 
 552      eif site_database:data:site:(keyof n):ip=(name_ip n:ip) 
 553        migrate := true 
 554    if migrate 
 555      para 
 556        page button "Drop no use sites IPs" 
 557          each name_database:data:name 
 558            if (name_ip site_database:data:site:(keyof n):computer)=(name_ip n:ip) 
 559              name_database:data:name delete keyof:n 
 560            eif site_database:data:site:(keyof n):ip=(name_ip n:ip) 
 561              name_database:data:name delete keyof:n 
 562          reload_page