Tcl Source Code

Check-in [dcc31e850c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge fork
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-456
Files: files | file ages | folders
SHA1: dcc31e850c74f5186a9a47adf43477f7bded12e6
User & Date: jan.nijtmans 2016-12-20 11:47:11
Context
2016-12-20
12:35
Make options -reuseaddr/-reuseport forbidden without -server, no matter the value being true or fals... check-in: bffa5b51a0 user: jan.nijtmans tags: tip-456
11:47
merge fork check-in: dcc31e850c user: jan.nijtmans tags: tip-456
10:56
Decouple the switch handling. check-in: 3d5331ac40 user: limeboy tags: tip-456
09:30
merge trunk (still has test failure in socket.test) check-in: fddd7e3bda user: jan.nijtmans tags: tip-456
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIOCmd.c.

1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499
1500
1501
1502
1503
....
1548
1549
1550
1551
1552
1553
1554


1555
1556
1557
1558
1559
1560
1561
....
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
....
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628



1629
1630
1631
1632
1633
1634
1635
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
	NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, boolTmp;

    unsigned int flags = TCL_TCPSERVER_REUSEADDR;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }
................................................................................
	case SKT_SERVER:
	    if (async == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		return TCL_ERROR;
	    }
	    server = 1;


	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -server option", -1));
		return TCL_ERROR;
	    }
	    script = objv[a];
................................................................................
	case SKT_REUSEADDR:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseaddr option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &boolTmp) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (boolTmp) {
		flags |= TCL_TCPSERVER_REUSEADDR;
	    } else {
		flags &= ~TCL_TCPSERVER_REUSEADDR;
	    }
	    break;
	case SKT_REUSEPORT:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseport option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &boolTmp) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (boolTmp) {
		flags |= TCL_TCPSERVER_REUSEPORT;
	    } else {
		flags &= ~TCL_TCPSERVER_REUSEPORT;
	    }
	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */
................................................................................
	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv,
		"-server command ?-reuseaddr boolean? ?-reuseport boolean? "
		"?-myaddr addr? port");
	return TCL_ERROR;
    }

    if (!server && flags != 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"options -reuseaddr and -reuseport are only valid for servers",
		-1));
	return TCL_ERROR;
    }




    // All the arguments should have been parsed by now, 'a' points to the last
    // one, the port number.
    if (a != objc-1) {
	goto wrongNumArgs;
    }







|
>
|







 







>
>







 







|


<
<
<
<
<








|


<
<
<
<
<







 







|





>
>
>







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
....
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
....
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575





1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586





1587
1588
1589
1590
1591
1592
1593
....
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
	NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = 0,
	reusea = 0;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }
................................................................................
	case SKT_SERVER:
	    if (async == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		return TCL_ERROR;
	    }
	    server = 1;
	    /* [TIP#456] Set for backward-compatibility. */
	    reusea = 1;
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -server option", -1));
		return TCL_ERROR;
	    }
	    script = objv[a];
................................................................................
	case SKT_REUSEADDR:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseaddr option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &reusea) != TCL_OK) {
		return TCL_ERROR;
	    }





	    break;
	case SKT_REUSEPORT:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseport option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) {
		return TCL_ERROR;
	    }





	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */
................................................................................
	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv,
		"-server command ?-reuseaddr boolean? ?-reuseport boolean? "
		"?-myaddr addr? port");
	return TCL_ERROR;
    }

    if (!server && (reusea != 0 || reusep != 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"options -reuseaddr and -reuseport are only valid for servers",
		-1));
	return TCL_ERROR;
    }

    flags |= reusea ? TCL_TCPSERVER_REUSEADDR : 0;
    flags |= reusep ? TCL_TCPSERVER_REUSEPORT : 0;

    // All the arguments should have been parsed by now, 'a' points to the last
    // one, the port number.
    if (a != objc-1) {
	goto wrongNumArgs;
    }