/[gnats]/gnats/contrib/tkgnats/tkpr_library.tcl
ViewVC logotype

Diff of /gnats/contrib/tkgnats/tkpr_library.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by mcr, Tue Jan 7 20:46:32 2003 UTC revision 1.10 by mcr, Tue Apr 1 02:48:28 2003 UTC
# Line 794  proc ftrim {s} { Line 794  proc ftrim {s} {
794      return [string trim $s "\t\n "]      return [string trim $s "\t\n "]
795  }  }
796    
797    proc gnatsd_send {s msg} {
798        global TkGnats
799    
800        #puts stderr "gnatsd_send $s $msg"
801    
802        if { [catch {puts $s $msg} errstr] } {
803          Msg "Failure writing to socket, assuming it was closed. Error: $errstr"
804          unset -nocomplain TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT))
805          set s  [open_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT) $keepopen]
806          gnatsd_chdb $s
807          puts $s $msg
808        }
809    }
810    
811  proc gnatsd_chdb {s} {  proc gnatsd_chdb {s} {
812      global TkGnats      global TkGnats
813    
814        # intentionally, this does not use gnatsd_send to avoid a loop
815      puts $s "CHDB $TkGnats(GNATS_DBALIAS)"      puts $s "CHDB $TkGnats(GNATS_DBALIAS)"
816      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
817      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
# Line 820  proc open_socket_gnatsd {{keepopen {}}} Line 835  proc open_socket_gnatsd {{keepopen {}}}
835              return -1              return -1
836          }          }
837          set cmd [subst "USER $TkGnats(UseridPassword)"]          set cmd [subst "USER $TkGnats(UseridPassword)"]
838          puts $s $cmd          gnatsd_send $s $cmd
839          set rep [get_socket_reply $s]              set rep [get_socket_reply $s]    
840          if {[string match 2* [lindex $rep 0]]} {          if {[string match 2* [lindex $rep 0]]} {
841              set accesslevelstr [lindex [lindex $rep 1] end]              set accesslevelstr [lindex [lindex $rep 1] end]
# Line 925  proc get_gnats_list_socket {type} { Line 940  proc get_gnats_list_socket {type} {
940          set cmd {LIST Responsible}          set cmd {LIST Responsible}
941      }      }
942    
943      puts $s $cmd      gnatsd_send $s $cmd
944      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
945      if {![string match 301* [lindex $rep 0]]} {      if {![string match 301* [lindex $rep 0]]} {
946          Msg "GNATSD error getting GNATS $type list:\n" "[join $rep \n]"          Msg "GNATSD error getting GNATS $type list:\n" "[join $rep \n]"
# Line 958  proc get_gnats_fieldvalue_socket {type} Line 973  proc get_gnats_fieldvalue_socket {type}
973          return -1          return -1
974      }      }
975    
976      puts $s "FVLD $type"      gnatsd_send $s "FVLD $type"
977      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
978      if {![string match 301* [lindex $rep 0]]} {      if {![string match 301* [lindex $rep 0]]} {
979          Msg "GNATSD error getting GNATS $type list:\n" "[join $rep \n]"          Msg "GNATSD error getting GNATS $type list:\n" "[join $rep \n]"
# Line 1168  proc get_audittrail_state {field} { Line 1183  proc get_audittrail_state {field} {
1183          return -1          return -1
1184      }      }
1185    
1186      puts $s "FIELDFLAGS $field"      gnatsd_send $s "FIELDFLAGS $field"
1187            
1188      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
1189    
# Line 1238  proc textset {l t {p ""} {e text}} { Line 1253  proc textset {l t {p ""} {e text}} {
1253          ${p}._${l}.$e config -state $state          ${p}._${l}.$e config -state $state
1254          return          return
1255      }      }
1256      #error "no such window for $l"      error "no such window for $l"
1257  }  }
1258    
1259  proc textget {l {p ""} {e text}} {  proc textget {l {p ""} {e text}} {
# Line 2113  proc check_release_based_socket {} { Line 2128  proc check_release_based_socket {} {
2128          return -1          return -1
2129      }      }
2130    
2131      puts $s "KYWD"      gnatsd_send $s "KYWD"
2132      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
2133      #puts "rep=$rep"        #puts "rep=$rep"  
2134      if {[string first "Unrecognized command" [lindex $rep 0]] < 0} {      if {[string first "Unrecognized command" [lindex $rep 0]] < 0} {
# Line 2146  proc check_release_based {} { Line 2161  proc check_release_based {} {
2161  #        return -1  #        return -1
2162  #    }  #    }
2163  #  #
2164  #    puts $s "LCFG"  #    gnatsd_send $s "LCFG"
2165  #    set rep [get_socket_reply $s]  #    set rep [get_socket_reply $s]
2166  #    #puts "rep=$rep"    #    #puts "rep=$rep"  
2167  #    if {![string match 2* [lindex $rep 0]]} {  #    if {![string match 2* [lindex $rep 0]]} {
# Line 2486  proc TkGnats_sendmail_smtp {addrs mailtx Line 2501  proc TkGnats_sendmail_smtp {addrs mailtx
2501    
2502      set my_addr $TkGnats(HOSTNAME)      set my_addr $TkGnats(HOSTNAME)
2503            
2504      puts $s "HELO $my_addr"      gnatsd_send $s "HELO $my_addr"
2505      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
2506      #puts "rep=$rep"      #puts "rep=$rep"
2507      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
# Line 2496  proc TkGnats_sendmail_smtp {addrs mailtx Line 2511  proc TkGnats_sendmail_smtp {addrs mailtx
2511      }      }
2512            
2513      set add [lindex [extract_email_address $TkGnats(EmailAddr)] 0]      set add [lindex [extract_email_address $TkGnats(EmailAddr)] 0]
2514      puts $s "MAIL FROM: <$add>"      gnatsd_send $s "MAIL FROM: <$add>"
2515      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
2516      #puts "rep=$rep"      #puts "rep=$rep"
2517      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
# Line 2510  proc TkGnats_sendmail_smtp {addrs mailtx Line 2525  proc TkGnats_sendmail_smtp {addrs mailtx
2525          if {$add == {}} {          if {$add == {}} {
2526              continue              continue
2527          }          }
2528          puts $s "RCPT TO: <$add>"          gnatsd_send $s "RCPT TO: <$add>"
2529          set rep [get_socket_reply $s]          set rep [get_socket_reply $s]
2530          #puts "rep=$rep"          #puts "rep=$rep"
2531          if {![string match 2* [lindex $rep 0]]} {          if {![string match 2* [lindex $rep 0]]} {
# Line 2522  proc TkGnats_sendmail_smtp {addrs mailtx Line 2537  proc TkGnats_sendmail_smtp {addrs mailtx
2537    
2538      set mailtxt [escape_dots $mailtxt]      set mailtxt [escape_dots $mailtxt]
2539            
2540      puts $s "DATA"      gnatsd_send $s "DATA"
2541      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
2542      #puts "rep=$rep"      #puts "rep=$rep"
2543      if {![string match 3* [lindex $rep 0]]} {      if {![string match 3* [lindex $rep 0]]} {
# Line 2531  proc TkGnats_sendmail_smtp {addrs mailtx Line 2546  proc TkGnats_sendmail_smtp {addrs mailtx
2546          return -1          return -1
2547      }      }
2548            
2549      puts $s $mailtxt      gnatsd_send $s $mailtxt
2550      puts $s "."      gnatsd_send $s "."
2551      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
2552      #puts "rep=$rep"      #puts "rep=$rep"
2553      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
# Line 3096  proc lock_pr_socket {me prid txt} { Line 3111  proc lock_pr_socket {me prid txt} {
3111          set text "Can't open socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"          set text "Can't open socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"
3112          return 1          return 1
3113      }      }
3114      puts $s "LOCK $prid $me"      gnatsd_send $s "LOCK $prid $me"
3115      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3116      #puts "rep=$rep"      #puts "rep=$rep"
3117      if {![string match 300* [lindex $rep 0]]} {      if {![string match 300* [lindex $rep 0]]} {
# Line 3152  proc unlock_pr_socket {prid} { Line 3167  proc unlock_pr_socket {prid} {
3167      if {[set s [open_socket_gnatsd]] == "-1"} {      if {[set s [open_socket_gnatsd]] == "-1"} {
3168          return "Error-3 opening socket/port $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"          return "Error-3 opening socket/port $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"
3169      }      }
3170      puts $s "UNLK $prid"      gnatsd_send $s "UNLK $prid"
3171      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3172      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
3173          set rep [lindex $rep 0]          set rep [lindex $rep 0]
# Line 3190  proc get_pr_full_text_socket {prid} { Line 3205  proc get_pr_full_text_socket {prid} {
3205      if {[set s [open_socket_gnatsd]] == "-1"} {      if {[set s [open_socket_gnatsd]] == "-1"} {
3206          return "-1"          return "-1"
3207      }      }
3208      puts $s "RSET"      gnatsd_send $s "RSET"
3209      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3210      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
3211          Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"          Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"
3212          return -1          return -1
3213      }      }
3214    
3215      puts $s "QFMT full"      gnatsd_send $s "QFMT full"
3216      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3217      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
3218          Msg "GNATSD error setting format to full text (for PRID $prid):\n" "[join $rep \n]"          Msg "GNATSD error setting format to full text (for PRID $prid):\n" "[join $rep \n]"
3219          return -1          return -1
3220      }      }
3221    
3222      puts $s "QUER $prid"      gnatsd_send $s "QUER $prid"
3223      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3224      if {![string match 300* [lindex $rep 0]]} {      if {![string match 300* [lindex $rep 0]]} {
3225          Msg "GNATSD error getting full text of PRID $prid:\n" "[join $rep \n]"          Msg "GNATSD error getting full text of PRID $prid:\n" "[join $rep \n]"
# Line 3230  proc get_pr_medium_text_socket {prid} { Line 3245  proc get_pr_medium_text_socket {prid} {
3245      if {[set s [open_socket_gnatsd]] == "-1"} {      if {[set s [open_socket_gnatsd]] == "-1"} {
3246          return "-1"          return "-1"
3247      }      }
3248      puts $s "RSET"      gnatsd_send $s "RSET"
3249      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3250      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
3251          Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"          Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"
3252          return -1          return -1
3253      }      }
3254      puts $s "QURY $prid"      gnatsd_send $s "QURY $prid"
3255      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
3256      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
3257          Msg "GNATSD error getting medium text of PRID $prid:\n" "[join $rep \n]"          Msg "GNATSD error getting medium text of PRID $prid:\n" "[join $rep \n]"
# Line 3372  proc load_field_defaults {field_array} { Line 3387  proc load_field_defaults {field_array} {
3387      chk_fld field(>Closed-Date)   "\n"      chk_fld field(>Closed-Date)   "\n"
3388      chk_fld field(>Start-Date)    "\n"      chk_fld field(>Start-Date)    "\n"
3389      chk_fld field(>End-Date)      "\n"      chk_fld field(>End-Date)      "\n"
3390      chk_fld field(>Cost)          "\n"      chk_fld field(>Cost)          ""
3391      chk_fld field(>Originator)    Unknown      chk_fld field(>Originator)    Unknown
3392      chk_fld field(>Responsible)   gnats      chk_fld field(>Responsible)   gnats
3393      chk_fld field(>Category)      pending      chk_fld field(>Category)      pending
# Line 3382  proc load_field_defaults {field_array} { Line 3397  proc load_field_defaults {field_array} {
3397      chk_fld field(>Environment)   "\n"      chk_fld field(>Environment)   "\n"
3398      chk_fld field(>Audit-Trail)   "\n"      chk_fld field(>Audit-Trail)   "\n"
3399      chk_fld field(>How-To-Repeat) "\n"      chk_fld field(>How-To-Repeat) "\n"
3400        chk_fld field(>IPsec-barf-location) "http://"
3401        chk_fld field(>IPsec-look)    "\n"
3402    
3403      chk_fld field(X-GNATS-Notify) nobody      chk_fld field(X-GNATS-Notify) nobody
3404    

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26