Tcl Source Code

Check-in [3d5331ac40]
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:Decouple the switch handling.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-456
Files: files | file ages | folders
SHA1: 3d5331ac4031f2aae55a96912f426c5faa69ae67
User & Date: limeboy 2016-12-20 10:56:53
Context
2016-12-20
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
10:22
Correct the handling of -server and its options. check-in: be51fb3542 user: limeboy 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
....
1548
1549
1550
1551
1552
1553
1554
1555

1556
1557
1558
1559
1560
1561
1562
....
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
1601
....
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629



1630
1631
1632
1633
1634
1635
1636
	"-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 = 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;
	    flags |= TCL_TCPSERVER_REUSEADDR;

	    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
....
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;
    }