From b5f11287fd21af818979d4dd23f0d21abfac1a83 Mon Sep 17 00:00:00 2001 From: patthoyts Date: Sun, 6 Jul 2008 12:27:30 +0000 Subject: [PATCH] Applied patch #1838467 (marttj) to avoid a crash when exiting with an open mcast socket. --- ChangeLog | 11 +++++--- generic/udp_tcl.c | 13 ++++++--- tests/udp.test | 67 +++++++++++++++++++++++++++++------------------ 3 files changed, 59 insertions(+), 32 deletions(-) diff --git a/ChangeLog b/ChangeLog index 627d62d..77bdc62 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,13 +1,16 @@ 2008-07-06 Pat Thoyts - * generic/udp_tcl.c: Applied patch #1838459 to properly handle - * tests/udp.test: appending to a shared list object in + * generic/udp_tcl.c: Applied patch #1838467 (marttj) to avoid a crash + * tests/udp.test: when exiting with an open mcast socket. + + * generic/udp_tcl.c: Applied patch #1838459 (marttj) to properly + * tests/udp.test: handle appending to a shared list object in -mcastadd. Added tests. 2008-07-05 Pat Thoyts - * generic/udp_tcl.c: Applied patch 1848365 to accept any boolean - value for the -mcastloop option (plus tests). + * generic/udp_tcl.c: Applied patch 1848365 (marttj) to accept any + * tests/udp.test: boolean value for -mcastloop (plus tests). 2007-04-10 Pat Thoyts diff --git a/generic/udp_tcl.c b/generic/udp_tcl.c index 8d8ed4d..d911ed5 100644 --- a/generic/udp_tcl.c +++ b/generic/udp_tcl.c @@ -890,11 +890,14 @@ udpClose(ClientData instanceData, Tcl_Interp *interp) */ if (statePtr->groupsObj) { int n = 0; - Tcl_ListObjGetElements(interp, statePtr->groupsObj, &objc, &objv); + Tcl_Obj *dupGroupList = Tcl_DuplicateObj(statePtr->groupsObj); + Tcl_IncrRefCount(dupGroupList); + Tcl_ListObjGetElements(interp, dupGroupList, &objc, &objv); for (n = 0; n < objc; n++) { UdpMulticast((ClientData)statePtr, interp, Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP); } + Tcl_DecrRefCount(dupGroupList); Tcl_DecrRefCount(statePtr->groupsObj); } @@ -1194,7 +1197,9 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp, if (mreq.imr_multiaddr.s_addr == -1) { name = gethostbyname(grp); if (name == NULL) { - Tcl_SetResult(interp, "invalid group name", TCL_STATIC); + if (interp != NULL) { + Tcl_SetResult(interp, "invalid group name", TCL_STATIC); + } return TCL_ERROR; } memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr, @@ -1203,7 +1208,9 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp, mreq.imr_interface.s_addr = INADDR_ANY; if (setsockopt(statePtr->sock, IPPROTO_IP, action, (const char*)&mreq, sizeof(mreq)) < 0) { - Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group")); + if (interp != NULL) { + Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group")); + } return TCL_ERROR; } diff --git a/tests/udp.test b/tests/udp.test index 70331ae..2f6cd79 100644 --- a/tests/udp.test +++ b/tests/udp.test @@ -20,32 +20,35 @@ package require udp # ------------------------------------------------------------------------- -test udp-1.0 {udp_open with any port} { - global _udp - list [catch { - set _udp [udp_open] - regexp {sock\d+} $_udp } msg] $msg -} {0 1} - -test udp-1.1 {udp_conf -myport} { - global _udp - list [catch {string is integer [udp_conf $_udp -myport]} msg] $msg -} {0 1} - -test udp_1.3 {close udp socket} { - global _udp - list [catch {close $_udp} msg] $msg -} {0 {}} +test udp-1.0 {udp_open with any port} -body { + set s [udp_open] +} -cleanup { + close $s +} -match regexp -result {sock\d+} -test udp-1.4 {udp_open on assigned port} { - list [catch { - set port 0xf0b0 - set s [udp_open $port] - set check [udp_conf $s -myport] - close $s - format 0x%04x $check - } msg] $msg -} {0 0xf0b0} +test udp-1.1 {udp_conf -myport} -setup { + set s [udp_open] +} -body { + udp_conf $s -myport +} -cleanup { + close $s +} -match regexp -result {^\d+$} + +test udp_1.3 {fconfigure -myport} -setup { + set s [udp_open] +} -body { + fconfigure $s -myport +} -cleanup { + close $s +} -match regexp -result {^\d+$} + +test udp-1.4 {udp_open on assigned port} -body { + set port 0xf0b0 + set s [udp_open $port] + format 0x%04x [udp_conf $s -myport] +} -cleanup { + close $s +} -result {0xf0b0} test udp-1.5 {udp_conf -remote before seting remote details} { list [catch { @@ -203,6 +206,20 @@ test udp-3.11 {-mcastloop is boolean - on/off} -setup { close $s } -result {1 0} + + +test udp-10.1 "bug #1838467 - crash on exit" -setup { + set s [udp_open] +} -body { + # Note: this test actually causes a crash on process exit when it + # fails. The socket needs to be left open ... + fconfigure $s -mcastadd 224.0.10.10 + fconfigure $s -mcastadd 224.0.10.11 + fconfigure $s -mcastadd 224.0.10.12 +} -cleanup { + # close $s - not closed on purpose +} -result {224.0.10.10 224.0.10.11 224.0.10.12} + # ------------------------------------------------------------------------- # cleanup catch {unset _udp} -- 2.23.0