external/bsd/bind/dist/contrib/idn/idnkit-1.0-src/wsock/config/idnconf.tcl

   1 # Id: idnconf.tcl,v 1.1.1.1 2003/06/04 00:27:42 marka Exp
   2 #
   3 # idnconf.tcl - configure idn wrapper
   4 #
   5
   6 #############################################################################
   7 #  Copyright (c) 2000,2002 Japan Network Information Center.
   8 #  All rights reserved.
   9 #
  10 #  By using this file, you agree to the terms and conditions set forth bellow.
  11 #
  12 #                       LICENSE TERMS AND CONDITIONS
  13 #
  14 #  The following License Terms and Conditions apply, unless a different
  15 #  license is obtained from Japan Network Information Center ("JPNIC"),
  16 #  a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
  17 #  Chiyoda-ku, Tokyo 101-0047, Japan.
  18 #
  19 #  1. Use, Modification and Redistribution (including distribution of any
  20 #     modified or derived work) in source and/or binary forms is permitted
  21 #     under this License Terms and Conditions.
  22 #
  23 #  2. Redistribution of source code must retain the copyright notices as they
  24 #     appear in each source code file, this License Terms and Conditions.
  25 #
  26 #  3. Redistribution in binary form must reproduce the Copyright Notice,
  27 #     this License Terms and Conditions, in the documentation and/or other
  28 #     materials provided with the distribution.  For the purposes of binary
  29 #     distribution the "Copyright Notice" refers to the following language:
  30 #     "Copyright (c) 2000-2002 Japan Network Information Center.  All rights reserved."
  31 #
  32 #  4. The name of JPNIC may not be used to endorse or promote products
  33 #     derived from this Software without specific prior written approval of
  34 #     JPNIC.
  35 #
  36 #  5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
  37 #     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  38 #     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  39 #     PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL JPNIC BE LIABLE
  40 #     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  41 #     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  42 #     SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  43 #     BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  44 #     WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  45 #     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  46 #     ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
  47 #############################################################################
  48
  49 global  configFile configBack
  50 global  registryKey registryEnc registryDef
  51 global  filesCpy filesRen filesDel
  52
  53 # idnkit version
  54 set version     "1.0"
  55
  56 set configFile  "idnconf.lst"   ;# list of wrapped program
  57 set configBack  "idnconf.bak"   ;# backup of previous data
  58
  59 set serverKey           "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN"
  60 set serverLogLevel      LogLevel
  61 set serverLogLevelDef   -1
  62 set serverLogLevelNone  -1
  63 set serverLogFile       LogFile
  64 set serverLogFileDef    {C:\idn_wrapper.log}
  65 set serverConfFile      ConfFile
  66
  67 set perprogKey          "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN\\PerProg\\"
  68 set perprogEnc          Encoding
  69 set perprogDef          Default
  70
  71 set logFileNameDef      idn_wrapper.log
  72 set confFileNameDef     idn.conf
  73
  74 set filesCpy11 { "wsock32.dll" }
  75 set filesCpy20 { "wsock32.dll" "ws2_32.dll" }
  76 set filesDel11 { "wsock32.dll" }
  77 set filesDel20 { "wsock32.dll" "ws2_32.dll" }
  78
  79 set local_dll           0
  80
  81 ########################################################################
  82 #
  83 # OS version check
  84 #
  85
  86 proc get_os_version {} {
  87     global os_version tcl_platform
  88
  89     if {[llength [info globals os_version]] > 0} {
  90         return $os_version
  91     }
  92
  93     switch -- $tcl_platform(os) {
  94         "Windows 95" {
  95             switch -- $tcl_platform(osVersion) {
  96                 4.0 {
  97                     set os_version {Windows 95}
  98                 }
  99                 4.10 {
 100                     set os_version {Windows 98}
 101                 }
 102                 4.90 {
 103                     set os_version {Windows Me}
 104                 }
 105             }
 106         }
 107         "Windows NT" {
 108             switch -- $tcl_platform(osVersion) {
 109                 3.51 -
 110                 4.0 {
 111                     set os_version {Windows NT}
 112                 }
 113                 5.0 {
 114                     set os_version {Windows 2000}
 115                 }
 116                 default {
 117                     # XP or .NET
 118                     set os_version {Windows XP}
 119                 }
 120             }
 121         }
 122         "Win32s" {
 123             error "idn wrapper does not support Windows 3.1"
 124         }
 125         default {
 126             set os_version "Unknown"
 127         }
 128     }
 129     set os_version
 130 }
 131
 132 proc support_dll_redirection {} {
 133     global dll_redirection
 134
 135     if {[llength [info globals dll_redirection]] > 0} {
 136         return $dll_redirection
 137     }
 138
 139     switch -- [get_os_version] {
 140         {Windows 95} -
 141         {Windows NT} {
 142             # cannot force local DLL reference by .local file.
 143             set dll_redirection 0
 144         }
 145         default {
 146             set dll_redirection 1
 147         }
 148     }
 149     set dll_redirection
 150 }
 151
 152 ########################################################################
 153 #
 154 # handling pathname
 155 #
 156
 157 proc getExeName { prg } {
 158     set elem [file split $prg]
 159     set leng [expr {[llength $elem] - 1}]
 160     set name [lindex $elem $leng]
 161     set exe  [file rootname $name]
 162     return $exe
 163 }
 164
 165 proc getDirName { prg } {
 166     file dirname $prg
 167 }
 168
 169 proc getSystemDir {} {
 170     global env
 171     switch -- [get_os_version] {
 172         "Windows 95" -
 173         "Windows 98" -
 174         "Windows Me" {
 175             set sysDir $env(windir)/system
 176         }
 177         default {
 178             set sysDir $env(SystemRoot)/system32
 179         }
 180     }
 181     return $sysDir
 182 }
 183
 184 ########################################################################
 185 #
 186 # loadList / saveList
 187 #
 188 #   loadList - load list of wrapped executables from $configFile
 189 #   saveList - save list of wrapped executables into $configFile
 190 #
 191
 192 proc loadList {} {
 193
 194     global configFile configBack
 195
 196     if { [file exists $configFile] } {
 197         file copy -force $configFile $configBack
 198     }
 199
 200     set aList {}
 201     set fd [open $configFile {CREAT RDONLY}]
 202     while { ! [eof $fd]} {
 203         set line [gets $fd]
 204         if { [string length $line] > 0} {
 205             lappend aList "$line"
 206         }
 207     }
 208     close $fd
 209     return $aList
 210 }
 211
 212 proc saveList { aList } {
 213     global configFile
 214     file delete -force $configFile
 215     set fd [open $configFile {CREAT WRONLY}]
 216     foreach e $aList {
 217         puts $fd $e
 218     }
 219     close $fd
 220 }
 221
 222 ########################################################################
 223 #
 224 # putList / getList - set/get list to/from listbox
 225 #
 226
 227 proc putList { lb aList } {
 228     foreach e $aList {
 229         $lb insert end $e
 230     }
 231 }
 232
 233 proc getList { lb } {
 234     $lb get 0 end
 235 }
 236
 237 ########################################################################
 238 #
 239 # checkList / appendList / deleteList - check / append / delete program from/to listbox
 240 #
 241
 242 proc checkList { lb prg } {
 243     set cnt 0
 244     set lst [getList $lb]
 245
 246     foreach n $lst {
 247         if { [string compare $prg $n] == 0 } {
 248             incr cnt
 249         }
 250     }
 251     return $cnt
 252 }
 253
 254 proc appendList { lb prg } {
 255
 256     if {  [checkList $lb $prg] == 0 } {
 257         $lb insert end $prg
 258     }
 259 }
 260
 261 proc deleteList { lb prg } {
 262     set cnt 0
 263     set lst [getList $lb]
 264
 265     foreach n $lst {
 266         if { [string compare $n $prg] == 0 } {
 267             $lb delete $cnt
 268         }
 269         incr cnt
 270     }
 271 }
 272
 273 ########################################################################
 274 #
 275 # registry operations
 276 #
 277
 278 proc regGetEncode { prg } {
 279
 280     global  perprogKey perprogEnc perprogDef
 281
 282     if { [string compare $prg "" ] == 0 } {
 283         return $perprogDef
 284     }
 285
 286     if {![isWindows]} {
 287         return $perprogDef
 288     }
 289     package require registry 1.0
 290
 291     set name [getExeName $prg]
 292     set key $perprogKey$name
 293
 294     if { [catch {set enc [registry get $key $perprogEnc]} err] } {
 295         return $perprogDef
 296     }
 297     if { [string compare $enc ""] == 0 } {
 298         return $perprogDef
 299     }
 300     return $enc
 301 }
 302
 303 proc regSetEncode { prg enc } {
 304
 305     global  perprogKey perprogEnc perprogDef
 306
 307     if {![isWindows]} {
 308         return 1
 309     }
 310
 311     package require registry 1.0
 312
 313     set name [getExeName $prg]
 314     set key $perprogKey$name
 315
 316     if { [string compare $enc $perprogDef] == 0 } {
 317         set enc ""
 318     }
 319     if { [catch {registry set $key $perprogEnc $enc sz} ] } {
 320         return 2
 321     }
 322     return 0
 323 }
 324
 325 proc regGetLogLevel {} {
 326     global serverKey serverLogLevel serverLogLevelDef
 327     regGetValue $serverKey $serverLogLevel $serverLogLevelDef
 328 }
 329
 330 proc regSetLogLevel {level} {
 331     global serverKey serverLogLevel
 332     regSetValue $serverKey $serverLogLevel $level dword
 333 }
 334
 335 proc regGetLogFile {} {
 336     global serverKey serverLogFile serverLogFileDef
 337     set file [regGetValue $serverKey $serverLogFile $serverLogFileDef]
 338     if {[catch {file attributes $file -longname} lfile]} {
 339         # Maybe $file doesn't exist (yet).  Get the longname of
 340         # directory portion.
 341         set dir [file dirname $file]
 342         if {[catch {file attributes $dir -longname} ldir]} {
 343             set ldir $dir
 344         }
 345         set lfile [file join $ldir [file tail $file]]
 346     }
 347     file nativename $lfile
 348 }
 349
 350 proc regSetLogFile {file} {
 351     global serverKey serverLogFile
 352     regSetValue $serverKey $serverLogFile [file nativename $file]
 353 }
 354
 355 proc regGetConfFile {} {
 356     global serverKey serverConfFile
 357     set file [regGetValue $serverKey $serverConfFile {}]
 358     if {[string compare $file {}] == 0} {
 359         return {}
 360     }
 361     if {[catch {file attributes $file -longname} lfile]} {
 362         # Maybe $file doesn't exist (yet).  Get the longname of
 363         # directory portion.
 364         set dir [file dirname $file]
 365         if {[catch {file attributes $dir -longname} ldir]} {
 366             set ldir $dir
 367         }
 368         set lfile [file join $ldir [file tail $file]]
 369     }
 370     file nativename $lfile
 371 }
 372
 373 proc regSetConfFile {file} {
 374     global serverKey serverConfFile
 375     regSetValue $serverKey $serverConfFile [file nativename $file]
 376 }
 377
 378 proc regGetWhere {} {
 379     global serverKey
 380     regGetValue $serverKey Where 0
 381 }
 382
 383 proc regSetWhere {where} {
 384     global serverKey
 385     regSetValue $serverKey Where $where dword
 386 }
 387
 388 proc regGetValue {key name default} {
 389     if {![isWindows]} {
 390         puts "--regGetValue $key $name"
 391         return $default
 392     }
 393     package require registry 1.0
 394
 395     if {[catch {registry get $key $name} value]} {
 396         return $default
 397     }
 398     if {[string compare $value {}] == 0} {
 399         return $default
 400     }
 401     return $value
 402 }
 403
 404 proc regSetValue {key name value {type sz}} {
 405     if {![isWindows]} {
 406         puts "--regSetValue $key $name $value"
 407         return 1
 408     }
 409
 410     package require registry 1.0
 411
 412     if {[catch {registry set $key $name $value $type}]} {
 413         return 2
 414     }
 415     return 0
 416 }
 417
 418 ########################################################################
 419 #
 420 # install / uninstall DLL s
 421 #
 422
 423 proc fileInstall { prg } {
 424
 425     global env
 426     global filesCpy11 filesCpy20
 427
 428     if {![isWindows]} {
 429         return 1
 430     }
 431
 432     switch -- [get_os_version] {
 433         "Windows 95" -
 434         "Windows 98" -
 435         "Windows Me" {
 436             set winDir $env(windir)
 437             set sysDir $winDir/system
 438             set filesCpy $filesCpy11
 439         }
 440         default {
 441             set winDir $env(SystemRoot)
 442             set sysDir $winDir/system32
 443             set filesCpy $filesCpy20
 444         }
 445     }
 446
 447     set toDir [getDirName $prg ]
 448
 449     foreach n $filesCpy {
 450         file copy -force $n $toDir
 451     }
 452     return 0
 453 }
 454
 455 proc fileRemove { prg } {
 456
 457     global filesDel11 filesDel20
 458
 459     if {![isWindows]} {
 460         return 1
 461     }
 462
 463     switch -- [get_os_version] {
 464         "Windows 95" {
 465             set filesDel $filesDel11
 466         }
 467         "Windows 98" -
 468         "Windows Me" {
 469             set filesDel $filesDel20
 470         }
 471         default {
 472             set filesDel $filesDel20
 473         }
 474     }
 475
 476     set fromDir [getDirName $prg ]
 477
 478     foreach n $filesDel {
 479         file delete -force $fromDir/$n
 480     }
 481     return 0
 482 }
 483
 484 ########################################################################
 485 #
 486 # Wrap/Unwrap program
 487 #
 488
 489 proc execWrap { pw lb dlg prg enc } {
 490
 491     set prgName [$prg get]
 492     set encName [$enc get]
 493
 494     # Make sure the program name is not empty
 495     if {[string compare $prgName {}] == 0} {
 496         confErrorDialog $dlg "Program must be specified.\nClick \"Browse..\" button for browsing."
 497         return
 498     }
 499
 500     # It is dangerous to wrap programs in the system directory.
 501     set prgdir [file nativename [getDirName $prgName]]
 502     set sysdir [file nativename [getSystemDir]]
 503     if {[string compare -nocase $prgdir $sysdir] == 0} {
 504         tk_messageBox -icon error -type ok -title "Directory Error" \
 505                 -parent $dlg \
 506                 -message "Cannot wrap applications in the system directory.\nPlease copy the EXE file to elsewhere and wrap the copied one."
 507         destroy $dlg
 508         return 1
 509     }
 510
 511     # Okay, copy the wrapper DLLs.
 512     if { [fileInstall $prgName] } {
 513         tk_messageBox -icon warning -type ok \
 514                       -title "Warning" \
 515                       -message "Cannot install DLLs" \
 516                       -parent $dlg
 517         destroy $dlg
 518         return 1
 519     }
 520     if { [regSetEncode $prgName $encName] } {
 521         tk_messageBox -icon warning -type ok \
 522                       -title "Warning" \
 523                       -message "Cannot set encoding" \
 524                       -parent $dlg
 525         fileRemove $prgName
 526         destroy $dlg
 527         return 2
 528     }
 529
 530     # if local flag is on, create $prgName.local.
 531     global local_dll
 532     if {$local_dll} {
 533         create_dot_local $prgName $dlg
 534     } else {
 535         remove_dot_local $prgName $dlg
 536     }
 537
 538     if { [checkList $lb $prgName] == 0 } {
 539         appendList $lb $prgName
 540     }
 541     saveList [getList $lb]
 542     destroy $dlg
 543 }
 544
 545 proc execUnwrap { pw lb dlg prg } {
 546
 547     set prgName [$prg get]
 548
 549     if {[support_dll_redirection] && [file exists $prgName.local]} {
 550         set ans [tk_messageBox -icon question -type yesno \
 551                         -title "Confirmation" \
 552                         -message "Also remove $prgName.local file?" \
 553                         -parent $dlg]
 554         if {[string compare $ans yes] == 0} {
 555             remove_dot_local $prgName $dlg
 556         }
 557     }
 558
 559     if { [checkList $lb $prgName] == 1 } {
 560         fileRemove $prgName
 561     }
 562     deleteList $lb $prgName
 563     saveList [getList $lb]
 564     destroy $dlg
 565 }
 566
 567 proc create_dot_local {path {parent .}} {
 568     set dotlocal $path.local
 569     if {[file exists $dotlocal]} {
 570         return 0
 571     }
 572     if {[catch {open $dotlocal w} fh]} {
 573         tk_messageBox -icon warning -type ok -title "Warning" \
 574                 -message "Cannot create $dotlocal" -parent $parent
 575         return -1
 576     }
 577     close $fh
 578     return 0
 579 }
 580
 581 proc remove_dot_local {path {parent .}} {
 582     set dotlocal $path.local
 583     if {[file exists $dotlocal] && [catch {file delete $dotlocal}]} {
 584         tk_messageBox -icon warning -type ok -title "Warning" \
 585                 -message "Cannot remove $dotlocal" -parent $parent
 586         return -1
 587     }
 588     return 0
 589 }
 590
 591 ########################################################################
 592 #
 593 # dialog for Wrap / Unwrap
 594 #
 595
 596 proc syncEncode { v i op } {
 597     global prgName encName
 598     set enc [regGetEncode $prgName]
 599     if { [string compare $encName $enc] != 0 } {
 600         set encName $enc
 601     }
 602 }
 603
 604 proc confBrowse { p ePrg eEnc } {
 605
 606     set types {
 607         { "Executable" .exe }
 608     }
 609
 610     set file [tk_getOpenFile -filetypes $types -parent $p ]
 611
 612     if { [string compare $file ""] == 0 } {
 613         return
 614     }
 615     set enc [regGetEncode $file]
 616     $ePrg delete 0 end
 617     $ePrg insert 0 $file
 618 }
 619
 620 proc confWrap { pw lb } {
 621
 622     global prgName encName local_dll
 623
 624     set idx [$lb curselection]
 625     if { [llength $idx] == 1 } {
 626         set prg [$lb get $idx]
 627         set local_dll [file exists $prg.local]
 628     } else {
 629         set prg ""
 630     }
 631
 632     set top .wrap
 633     toplevel $top
 634     grab     $top
 635     wm title $top "idn wrapper - Wrap Executable"
 636
 637     frame $top.f1 -bd 1 -relief raised
 638     frame $top.f2 -bd 1 -relief raised
 639     pack $top.f1 -side top -fill x -expand on
 640     pack $top.f2 -side top -fill x -expand on
 641
 642     frame $top.f1.f
 643     pack $top.f1.f -fill both -expand on -padx 4 -pady 4
 644
 645     set w $top.f1.f
 646     label $w.prgtitle -text "Program:"
 647     label $w.enctitle -text "Encoding:"
 648
 649     entry $w.prgname -relief sunken -width 56 -textvariable prgName
 650     entry $w.encname -relief sunken -width  8 -textvariable encName
 651     set w_prgname $w.prgname
 652     set w_encname $w.encname
 653     button $w.browse -text "Browse.." \
 654                 -command [list confBrowse $w $w_prgname $w_encname]
 655
 656     frame $w.rbf
 657     radiobutton $w.rbf.encdef -text "Default" -variable encName \
 658             -value "Default"
 659     radiobutton $w.rbf.encutf -text "UTF-8"   -variable encName \
 660             -value "UTF-8"
 661     pack $w.rbf.encdef $w.rbf.encutf -side left -padx 4
 662
 663     grid $w.prgtitle -row 0 -column 0 -sticky e
 664     grid $w.enctitle -row 1 -column 0 -sticky e
 665     grid $w.prgname  -row 0 -column 1 -sticky we -pady 4 -padx 2 -columnspan 2
 666     grid $w.browse   -row 0 -column 3 -sticky w  -pady 4 -padx 4
 667     grid $w.encname  -row 1 -column 1 -sticky we -pady 4 -padx 2
 668     grid $w.rbf      -row 1 -column 2 -sticky w -padx 2
 669     if {[support_dll_redirection]} {
 670         checkbutton $w.local -text "Force local DLL reference" \
 671                 -variable local_dll
 672         grid $w.local    -row 2 -column 1 -sticky w -padx 4 -pady 4
 673     }
 674     grid columnconfig $w 1 -weight 1 -minsize 20
 675     grid columnconfig $w 2 -weight 2 -minsize 20
 676
 677     trace variable prgName w syncEncode
 678
 679     $w.prgname delete 0 end
 680     $w.prgname insert 0 $prg
 681
 682     focus $w.prgname
 683
 684     set w $top.f2
 685     button $w.wrap   -text "Wrap" \
 686             -command [list execWrap $pw $lb $top $w_prgname $w_encname]
 687     button $w.cancel -text "Cancel" \
 688                 -command [list destroy $top]
 689     pack $w.cancel -side right -fill y -padx 12 -pady 4
 690     pack $w.wrap -side right -fill y -padx 12 -pady 4
 691
 692     tkwait window $top
 693 }
 694
 695 proc confUnwrap { pw lb } {
 696
 697     set idx [$lb curselection]
 698     if { [llength $idx] != 1 } {
 699         tk_messageBox -icon warning -type ok \
 700                       -title "Warning" \
 701                       -message "first, select unwrapping executable" \
 702                       -parent $pw
 703         return 0
 704     }
 705     set prg [$lb get $idx]
 706     if { [string length $prg] == 0 } {
 707         tk_messageBox -icon warning -type ok \
 708                       -title "Warning" \
 709                       -message "first, select unwrapping executable" \
 710                       -parent $pw
 711         return 0
 712     }
 713
 714     set top .unwrap
 715     toplevel $top
 716     grab     $top
 717     wm title $top "idn wrapper - Unwrap Executable"
 718
 719     frame $top.f1 -bd 1 -relief raised
 720     frame $top.f2 -bd 1 -relief raised
 721     pack $top.f2 -side bottom -fill x
 722     pack $top.f1 -side bottom -fill x -expand on
 723
 724     frame $top.f1.f
 725     pack $top.f1.f -padx 4 -pady 4 -fill both -expand on
 726     set w $top.f1.f
 727     label $w.prgtitle -text "Program:"
 728     entry $w.prgname -relief sunken -width 56 -textvariable prgName
 729     $w.prgname delete 0 end
 730     $w.prgname insert 0 $prg
 731
 732     set w_prgname $w.prgname
 733
 734     grid $w.prgtitle -row 0 -column 0 -sticky w
 735     grid $w.prgname  -row 0 -column 1 -sticky we -pady 4
 736     grid columnconfig $w 1 -weight 1 -minsize 20
 737
 738     set w $top.f2
 739     button $w.wrap   -text "Unwrap" \
 740                 -command [list execUnwrap $pw $lb $top $w_prgname]
 741     button $w.cancel -text "Cancel" \
 742                 -command [list destroy $top]
 743
 744     pack $w.cancel -side right -padx 12 -pady 6
 745     pack $w.wrap -side right -padx 12 -pady 6
 746
 747     focus $w.wrap
 748     tkwait window $top
 749 }
 750
 751 proc unwrapAll {pw lb} {
 752     set ans [tk_messageBox -type yesno -default no -icon question \
 753             -parent $pw -title {idn wrapper Configuration} \
 754             -message {Really unwrap all programs?}]
 755     if {[string compare $ans yes] != 0} {
 756         return
 757     }
 758
 759     foreach prog [$lb get 0 end] {
 760         fileRemove $prog
 761     }
 762
 763     if {[support_dll_redirection]} {
 764         set delete_type yes
 765         foreach prog [$lb get 0 end] {
 766             if {![file exists $prog.local]} continue
 767             switch -- $delete_type {
 768                 yes -
 769                 no {
 770                     set delete_type [dotLocalDialog $prog $delete_type]
 771                 }
 772             }
 773             switch -- $delete_type {
 774                 yes -
 775                 yesall {
 776                     remove_dot_local $prog $pw
 777                 }
 778             }
 779         }
 780     }
 781
 782     $lb delete 0 end
 783     saveList {}
 784 }
 785
 786 proc rewrapAll {pw lb} {
 787     set ans [tk_messageBox -type yesno -default yes -icon question \
 788             -parent $pw -title {idn wrapper Configuration} \
 789             -message {Really rewrap all programs?}]
 790     if {[string compare $ans yes] != 0} {
 791         return
 792     }
 793     foreach prog [$lb get 0 end] {
 794         fileInstall $prog
 795     }
 796 }
 797
 798 proc confLog {pw} {
 799     global _logLevel _logFile
 800
 801     set top .log
 802     catch {destroy $top}
 803     toplevel $top
 804     wm title $top "idn wrapper - Log Configuration"
 805     # wm transient $top $pw
 806
 807     set _logLevel [regGetLogLevel]
 808     set _logFile [regGetLogFile]
 809
 810     frame $top.f1 -bd 1 -relief raised
 811     frame $top.f2 -bd 1 -relief raised
 812     pack $top.f2 -side bottom -fill x
 813     pack $top.f1 -side top -fill both -expand on
 814
 815     set w $top.f1
 816     label $w.lv_l -text "Log Level:"
 817     frame $w.lv_v
 818     global serverLogLevelNone
 819     set i 0
 820     foreach {lvl text} [list $serverLogLevelNone None \
 821             0 Fatal 1 Error 2 Warning 3 Info 4 Trace] {
 822         radiobutton $w.lv_v.btn$i -text $text -value $lvl -variable _logLevel
 823         pack $w.lv_v.btn$i -side left -padx 3
 824         incr i
 825     }
 826     label $w.ld_l -text "Log File:"
 827     frame $w.ld_v
 828     entry $w.ld_v.e -width 40 -textvariable _logFile
 829     focus $w.ld_v.e
 830     button $w.ld_v.b -text "Browse.." -command [list selectLog $top $w.ld_v.e]
 831     pack $w.ld_v.b -side right -fill y -padx 6
 832     pack $w.ld_v.e -side left -fill both -expand yes
 833     #label $w.lo_l -text "Log Operation:"
 834     frame $w.lo_v
 835     button $w.lo_v.show -text "View" -command [list showLog $top]
 836     button $w.lo_v.delete -text "Delete" -command [list deleteLog $top]
 837     pack $w.lo_v.show $w.lo_v.delete -side left -padx 4
 838
 839     grid $w.lv_l -row 0 -column 0 -sticky e -padx 4
 840     grid $w.ld_l -row 1 -column 0 -sticky e -padx 4
 841     #grid $w.lo_l -row 2 -column 0 -sticky e -padx 4
 842     grid $w.lv_v -row 0 -column 1 -sticky w -padx 4 -pady 4
 843     grid $w.ld_v -row 1 -column 1 -sticky we -padx 4 -pady 4
 844     grid $w.lo_v -row 2 -column 1 -sticky w -padx 4 -pady 4
 845
 846     set w $top.f2
 847     button $w.ok -text "OK" -command [list configureLog $top]
 848     button $w.cancel -text "Cancel" -command [list destroy $top]
 849     pack $w.cancel -side right -padx 12 -pady 6
 850     pack $w.ok -side right -padx 12 -pady 6
 851 }
 852
 853 proc configureLog {top} {
 854     global _logLevel _logFile
 855
 856     if {$_logLevel != [regGetLogLevel] ||
 857         [string compare $_logFile [regGetLogFile]] != 0} {
 858         set dir [file dirname $_logFile]
 859         if {[string compare $dir {}]} {
 860             if {![file exists $dir]} {
 861                 confErrorDialog $top "Directory $dir doesn't exist"
 862                 return
 863             } elseif {![file isdirectory $dir]} {
 864                 confErrorDialog $top "$dir is not a directory"
 865                 return
 866             }
 867         }
 868         regSetLogLevel $_logLevel
 869         regSetLogFile $_logFile
 870         tk_messageBox -type ok -default ok -icon info -parent $top \
 871                 -title "idn wrapper Configuration" \
 872                 -message "Changing log level or file does not affect already running processes."
 873     }
 874     destroy $top
 875 }
 876
 877 proc selectLog {top e} {
 878     global logFileNameDef
 879     set file [tk_getSaveFile -title {idn wrapper Logfile Selection} \
 880             -defaultextension .log \
 881             -filetypes {{{Log Files} .log} {{All Files} *}} \
 882             -initialfile $logFileNameDef \
 883             -parent $top]
 884     if {[string compare $file {}]} {
 885         $e delete 0 end
 886         $e insert insert $file
 887     }
 888 }
 889
 890 proc showLog {top} {
 891     global _logFile
 892     if {[catch {exec notepad.exe $_logFile &} r]} {
 893         confErrorDialog $top "Cannot execute notepad"
 894     }
 895 }
 896
 897 proc deleteLog {top} {
 898     global _logFile
 899     set ans [tk_messageBox -type yesno -default no -icon question \
 900             -parent $top -title "idn wrapper Configuration" \
 901             -message "Really delete $_logFile?"]
 902     if {[string compare $ans yes] == 0} {
 903         file delete $_logFile
 904     }
 905 }
 906
 907 ########################################################################
 908 #
 909 # dialog for .local deletion
 910 #
 911
 912 proc dotLocalDialog {path {default yes}} {
 913     set parent .
 914     set dlg .dotlocaldlg
 915     catch {destroy $dlg}
 916     toplevel $dlg
 917
 918     wm iconname $dlg Dialog
 919     wm title $dlg Confirmation
 920     wm transient $dlg $parent
 921     wm protocol $dlg WM_DELETE_WINDOW {}
 922
 923     frame $dlg.f1 -bd 1 -relief raised
 924     frame $dlg.f2 -bd 1 -relief raised
 925     pack $dlg.f1 -side top -fill x -expand on -ipadx 2m -ipady 4m
 926     pack $dlg.f2 -side top -fill x -ipadx 2m
 927
 928     label $dlg.f1.bm -bitmap question -bd 0
 929     label $dlg.f1.msg -text "Remove $path.local?" -wraplength 10c
 930     pack $dlg.f1.bm -side left -padx 3m -pady 2m
 931     pack $dlg.f1.msg -side left -padx 2m -pady 2m
 932
 933     global dotlocal_selection
 934     foreach {btn lbl} {yes Yes no No yesall {Yes to All} noall {No to All}} {
 935         set bw $dlg.f2.btn$btn
 936         button $bw -text $lbl -default normal \
 937                 -command [list set dotlocal_selection $btn]
 938         if {[string compare $default $btn] == 0} {
 939             $bw configure -default active
 940             focus $bw
 941         }
 942         bind $bw <Return> {%W flash; %W invoke}
 943         pack $bw -side left -padx 3m -pady 2m
 944     }
 945
 946     grab $dlg
 947     ::tk::PlaceWindow $dlg widget $parent
 948
 949     vwait dotlocal_selection
 950     destroy $dlg
 951     return $dotlocal_selection
 952 }
 953
 954 ########################################################################
 955 #
 956 # dialog for advanced configuration
 957 #
 958
 959 proc advancedConf {pw} {
 960     set top .adv
 961     catch {destroy $top}
 962     toplevel $top
 963     wm title $top "idn wrapper - Advanced Configuration"
 964
 965     global _mdnOperation _confFile
 966     set _mdnOperation [regGetWhere]
 967     set _confFile [regGetConfFile]
 968
 969     foreach f {f1 f2 f3} {
 970         frame $top.$f -bd 1 -relief raised
 971         pack $top.$f -side top -fill x
 972     }
 973
 974     set f $top.f1
 975     label $f.lbl -text {IDN Wrapping Mode}
 976     set w $f.f
 977     frame $w
 978     foreach {rb val txt} [list \
 979             rb1 0 {Wrap both WINSOCK 1.1 and WINSOCK 2.0} \
 980             rb2 2 {Wrap only WINSOCK 1.1} \
 981             rb3 3 {Wrap only WINSOCK 2.0} \
 982             rb4 1 "Wrap only WINSOCK2.0 if it exists.\nOtherwise wrap only WINSOCK1.1"] {
 983         radiobutton $w.$rb -text $txt -variable _mdnOperation -value $val \
 984                 -anchor w -justify left
 985         pack $w.$rb -side top -fill x -pady 1
 986     }
 987     pack $f.lbl -side top -fill x -pady 4
 988     pack $w -side top -fill both -padx 20 -pady 10
 989
 990     set f $top.f2
 991     label $f.lbl -text {IDN Configuration}
 992     pack $f.lbl -side top -fill x -pady 6
 993
 994     set w $f.f
 995     frame $w
 996     pack $w -side top -fill both -padx 10 -pady 6
 997     label $w.l1 -text {Config File:}
 998     #label $w.l2 -text {Config Operation:}
 999     entry $w.e -width 40 -textvariable _confFile
1000     focus $w.e
1001     button $w.br -text "Browse.." -command [list selectConf $top $w.e]
1002     button $w.b -text Edit -command [list editConf $top]
1003     grid $w.l1 -row 0 -column 0 -sticky e -padx 4
1004     #grid $w.l2 -row 1 -column 0 -sticky e -padx 4
1005     grid $w.e -row 0 -column 1 -sticky we -padx 4 -pady 4
1006     grid $w.b -row 1 -column 1 -sticky w -padx 4 -pady 4
1007     grid $w.br -row 0 -column 2 -sticky w -padx 4 -pady 4
1008
1009     set w $top.f3
1010     button $w.ok -text "OK" -command [list advConf $top]
1011     button $w.cancel -text "Cancel" -command [list destroy $top]
1012     pack $w.cancel -side right -padx 12 -pady 8
1013     pack $w.ok -side right -padx 12 -pady 8
1014 }
1015
1016 proc editConf {top} {
1017     global _confFile
1018     if {[catch {exec notepad.exe $_confFile &} r]} {
1019         confErrorDialog $top "Cannot execute notepad"
1020     }
1021 }
1022
1023 proc selectConf {top e} {
1024     global confFileNameDef
1025     set file [tk_getOpenFile -title {idn wrapper Config File Selection} \
1026             -defaultextension .conf \
1027             -filetypes {{{Config Files} .conf} {{All Files} *}} \
1028             -initialfile $confFileNameDef \
1029             -parent $top]
1030     if {[string compare $file {}]} {
1031         $e delete 0 end
1032         $e insert insert $file
1033     }
1034 }
1035
1036 proc advConf {top} {
1037     global _mdnOperation _confFile
1038     regSetWhere $_mdnOperation
1039     regSetConfFile $_confFile
1040     destroy $top
1041 }
1042
1043 ########################################################################
1044 #
1045 # utility
1046 #
1047
1048 proc confErrorDialog {top message} {
1049     tk_messageBox -default ok -icon error -parent $top -type ok \
1050             -title {idn wrapper Configuration Error} -message $message
1051 }
1052
1053 proc isWindows {} {
1054     global tcl_platform
1055     expr {[string compare $tcl_platform(platform) "windows"] == 0}
1056 }
1057
1058 ########################################################################
1059 #
1060 # config program start here
1061 #
1062
1063 wm title    . "idn wrapper - Configuration"
1064 wm iconname . "idn wrapper - Configuration"
1065
1066
1067 label .title -bd 1 -relief raised -pady 5 \
1068         -text "idn wrapper Configuration Program version $version"
1069
1070 frame .left -bd 1 -relief raised
1071 frame .right -bd 1 -relief raised
1072
1073 frame .lst
1074 label .lst.title -text "Wrapped Programs" -pady 3
1075 listbox .lst.list -width 64 -height 16 -setgrid 1 \
1076             -xscrollcommand ".lst.xscroll set" \
1077             -yscrollcommand ".lst.yscroll set"
1078 scrollbar .lst.yscroll -orient vertical   -command ".lst.list yview"
1079 scrollbar .lst.xscroll -orient horizontal -command ".lst.list xview"
1080 grid .lst.title   -row 0 -column 0 -columnspan 2 -sticky news
1081 grid .lst.list    -row 1 -column 0 -sticky news
1082 grid .lst.xscroll -row 2 -column 0 -sticky news
1083 grid .lst.yscroll -row 1 -column 1 -sticky news
1084 grid rowconfig .lst 1 -weight 1
1085 grid columnconfig .lst 0 -weight 1
1086
1087 frame .btn
1088 button .btn.wrap -text "Wrap.." -command [list confWrap . .lst.list]
1089 button .btn.unwrap -text "Unwrap.." -command [list confUnwrap . .lst.list]
1090 button .btn.unwrapall -text "Unwrap All" -command [list unwrapAll . .lst.list]
1091 button .btn.rewrapall -text "Rewrap All" -command [list rewrapAll . .lst.list]
1092 frame .btn.spacing1 -width 1 -height 12 -bd 0
1093 button .btn.log -text "Log.." -command [list confLog .]
1094 frame .btn.spacing2 -width 1 -height 12 -bd 0
1095 button .btn.adv -text "Advanced.." -command [list advancedConf .]
1096 button .btn.exit -text Exit -command exit
1097 pack .btn.wrap   -side top    -fill x -pady 4
1098 pack .btn.unwrap -side top    -fill x -pady 4
1099 pack .btn.unwrapall -side top -fill x -pady 4
1100 pack .btn.rewrapall -side top -fill x -pady 4
1101 pack .btn.spacing1 -side top
1102 pack .btn.log    -side top    -fill x -pady 4
1103 pack .btn.spacing2 -side top
1104 pack .btn.adv    -side top    -fill x -pady 4
1105 pack .btn.exit   -side bottom -fill x -pady 4
1106
1107 pack .lst -in .left -padx 4 -pady 4 -fill both -expand on
1108 pack .btn -in .right -padx 6 -pady 4 -fill both -expand on
1109
1110 pack .title -side top -fill x
1111 pack .right -side right -fill y
1112 pack .left -side left -fill y -expand on
1113
1114 #
1115 # then set current list into listbox
1116 #
1117
1118 set theList [loadList]
1119 #saveList $theList
1120 putList .lst.list $theList
1121
1122 #
1123 ########################################################################