Tcl Library Source Code

Check-in [9b67fcc749]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added a coroutine guard for file locking in nettool
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256: 9b67fcc74944c89cdd5586398fac889b56a0ff7c327cde9cde4eb92257cd4a91
User & Date: hypnotoad 2020-01-28 22:25:25
Context
2020-02-17
14:33
Merging changes from Trunk Leaf check-in: 4f943a9660 user: hypnotoad tags: hypnotoad
2020-01-28
22:25
Added a coroutine guard for file locking in nettool check-in: 9b67fcc749 user: hypnotoad tags: hypnotoad
21:15
Added an API call to set the sync file in nettool check-in: faca2007b6 user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/nettool/build/locateport.tcl.

52
53
54
55
56
57
58
59




60



61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

proc ::nettool::_die {filename} {




}





proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info






|
>
>
>
>
|
>
>
>
|









|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

proc ::nettool::sleep delay {
  if {[info coroutine] ne {}} {
    ::after $delay [list [info coroutine]]
    yield
    return
  }
  after $delay {set ::nettool::pause 0}
  vwait ::nettool::pause
  return
}

proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      ::nettool::sleep 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info

Changes to modules/nettool/nettool.tcl.

977
978
979
980
981
982
983
984




985



986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

proc ::nettool::_die {filename} {




}





proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info






|
>
>
>
>
|
>
>
>
|









|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

proc ::nettool::sleep delay {
  if {[info coroutine] ne {}} {
    ::after $delay [list [info coroutine]]
    yield
    return
  }
  after $delay {set ::nettool::pause 0}
  vwait ::nettool::pause
  return
}

proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      ::nettool::sleep 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info