AbstractOperatingSystem.st
branchjv
changeset 18640 358b275dced9
parent 18366 a6e62e167c32
parent 18639 3529a684d3fb
child 18744 0f193129cde0
equal deleted inserted replaced
18631:27ffa826691b 18640:358b275dced9
     1 "{ Encoding: utf8 }"
       
     2 
       
     3 "
     1 "
     4  COPYRIGHT (c) 1988 by Claus Gittinger
     2  COPYRIGHT (c) 1988 by Claus Gittinger
     5 	      All Rights Reserved
     3 	      All Rights Reserved
     6 
     4 
     7  This software is furnished under a license and may be used
     5  This software is furnished under a license and may be used
  1337      closeStreams|
  1335      closeStreams|
  1338 
  1336 
  1339     terminateLock := Semaphore forMutualExclusion.
  1337     terminateLock := Semaphore forMutualExclusion.
  1340     ((externalInStream := anInStream) notNil
  1338     ((externalInStream := anInStream) notNil
  1341      and:[externalInStream isExternalStream not]) ifTrue:[
  1339      and:[externalInStream isExternalStream not]) ifTrue:[
  1342 	pIn := NonPositionableExternalStream makePipe.
  1340         pIn := NonPositionableExternalStream makePipe.
  1343 	inStreamToClose := externalInStream := pIn at:1.
  1341         inStreamToClose := externalInStream := pIn at:1.
  1344 	shuffledInStream := pIn at:2.
  1342         shuffledInStream := pIn at:2.
  1345 	anInStream isBinary ifTrue:[
  1343         anInStream isBinary ifTrue:[
  1346 	    shuffledInStream binary
  1344             shuffledInStream binary
  1347 	].
  1345         ].
  1348 	lineWise ifFalse:[
  1346         lineWise ifFalse:[
  1349 	    shuffledInStream blocking:false.
  1347             shuffledInStream blocking:false.
  1350 	].
  1348         ].
  1351 
  1349 
  1352 	"/ start a reader process, shuffling data from the given
  1350         "/ start a reader process, shuffling data from the given
  1353 	"/ inStream to the pipe (which is connected to the commands input)
  1351         "/ inStream to the pipe (which is connected to the commands input)
  1354 	inputShufflerProcess :=
  1352         inputShufflerProcess :=
  1355 	    [
  1353             [
  1356 		[
  1354                 [
  1357 		    [anInStream atEnd] whileFalse:[
  1355                     [anInStream atEnd] whileFalse:[
  1358 			self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
  1356                         self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
  1359 			shuffledInStream flush
  1357                         shuffledInStream flush
  1360 		    ]
  1358                     ]
  1361 		] ensure:[
  1359                 ] ensure:[
  1362 		    shuffledInStream close
  1360                     shuffledInStream close
  1363 		]
  1361                 ]
  1364 	    ] newProcess
  1362             ] newProcess
  1365 		name:'cmd input shuffler';
  1363                 name:'cmd input shuffler';
  1366 "/                beSystemProcess;
  1364 "/                beSystemProcess;
  1367 		resume.
  1365                 resume.
  1368     ].
  1366     ].
  1369     ((externalOutStream := anOutStream) notNil
  1367     ((externalOutStream := anOutStream) notNil
  1370      and:[externalOutStream isExternalStream not]) ifTrue:[
  1368      and:[externalOutStream isExternalStream not]) ifTrue:[
  1371 	pOut := NonPositionableExternalStream makePipe.
  1369         pOut := NonPositionableExternalStream makePipe.
  1372 	shuffledOutStream := (pOut at:1).
  1370         shuffledOutStream := (pOut at:1).
  1373 	anOutStream isBinary ifTrue:[
  1371         anOutStream isBinary ifTrue:[
  1374 	    shuffledOutStream binary
  1372             shuffledOutStream binary
  1375 	].
  1373         ].
  1376 	outStreamToClose := externalOutStream := pOut at:2.
  1374         outStreamToClose := externalOutStream := pOut at:2.
  1377 	outputShufflerProcess :=
  1375         outputShufflerProcess :=
  1378 	    [
  1376             [
  1379 		WriteError handle:[:ex |
  1377                 WriteError handle:[:ex |
  1380 		    "/ ignored
  1378                     "/ ignored
  1381 		] do:[
  1379                 ] do:[
  1382 		    self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
  1380                     self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
  1383 		].
  1381                 ].
  1384 	    ] newProcess
  1382             ] newProcess
  1385 		priority:(Processor userSchedulingPriority + 1);
  1383                 priority:(Processor userSchedulingPriority "+ 1");
  1386 		name:'cmd output shuffler';
  1384                 name:'cmd output shuffler';
  1387 "/                beSystemProcess;
  1385 "/                beSystemProcess;
  1388 		resume.
  1386                 resume.
  1389     ].
  1387     ].
  1390     (externalErrStream := anErrStream) notNil ifTrue:[
  1388     (externalErrStream := anErrStream) notNil ifTrue:[
  1391 	anErrStream == anOutStream ifTrue:[
  1389         anErrStream == anOutStream ifTrue:[
  1392 	    externalErrStream := externalOutStream
  1390             externalErrStream := externalOutStream
  1393 	] ifFalse:[
  1391         ] ifFalse:[
  1394 	    anErrStream isExternalStream ifFalse:[
  1392             anErrStream isExternalStream ifFalse:[
  1395 		pErr := NonPositionableExternalStream makePipe.
  1393                 pErr := NonPositionableExternalStream makePipe.
  1396 		shuffledErrStream := (pErr at:1).
  1394                 shuffledErrStream := (pErr at:1).
  1397 		anErrStream isBinary ifTrue:[
  1395                 anErrStream isBinary ifTrue:[
  1398 		    shuffledErrStream binary
  1396                     shuffledErrStream binary
  1399 		].
  1397                 ].
  1400 		errStreamToClose := externalErrStream := pErr at:2.
  1398                 errStreamToClose := externalErrStream := pErr at:2.
  1401 		errorShufflerProcess :=
  1399                 errorShufflerProcess :=
  1402 		    [
  1400                     [
  1403 			self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
  1401                         self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
  1404 		    ] newProcess
  1402                     ] newProcess
  1405 			priority:(Processor userSchedulingPriority + 2);
  1403                         priority:(Processor userSchedulingPriority + 1);
  1406 			name:'cmd err-output shuffler';
  1404                         name:'cmd err-output shuffler';
  1407 "/                        beSystemProcess;
  1405 "/                        beSystemProcess;
  1408 			resume.
  1406                         resume.
  1409 	    ]
  1407             ]
  1410 	]
  1408         ]
  1411     ].
  1409     ].
  1412     ((externalAuxStream := anAuxStream) notNil
  1410     ((externalAuxStream := anAuxStream) notNil
  1413      and:[externalAuxStream isExternalStream not]) ifTrue:[
  1411      and:[externalAuxStream isExternalStream not]) ifTrue:[
  1414 	pAux := NonPositionableExternalStream makePipe.
  1412         pAux := NonPositionableExternalStream makePipe.
  1415 	auxStreamToClose := externalAuxStream := pAux at:1.
  1413         auxStreamToClose := externalAuxStream := pAux at:1.
  1416 	shuffledAuxStream := pAux at:2.
  1414         shuffledAuxStream := pAux at:2.
  1417 	shuffledAuxStream blocking:false.
  1415         shuffledAuxStream blocking:false.
  1418 	anAuxStream isBinary ifTrue:[
  1416         anAuxStream isBinary ifTrue:[
  1419 	    shuffledAuxStream binary
  1417             shuffledAuxStream binary
  1420 	].
  1418         ].
  1421 
  1419 
  1422 	"/ start a reader process, shuffling data from the given
  1420         "/ start a reader process, shuffling data from the given
  1423 	"/ auxStream to the pipe (which is connected to the commands aux)
  1421         "/ auxStream to the pipe (which is connected to the commands aux)
  1424 	auxShufflerProcess :=
  1422         auxShufflerProcess :=
  1425 	    [
  1423             [
  1426 		[
  1424                 [
  1427 		    [anAuxStream atEnd] whileFalse:[
  1425                     [anAuxStream atEnd] whileFalse:[
  1428 			self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
  1426                         self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
  1429 			shuffledAuxStream flush
  1427                         shuffledAuxStream flush
  1430 		    ]
  1428                     ]
  1431 		] ensure:[
  1429                 ] ensure:[
  1432 		    shuffledAuxStream close
  1430                     shuffledAuxStream close
  1433 		]
  1431                 ]
  1434 	    ] newProcess
  1432             ] newProcess
  1435 		name:'cmd aux shuffler';
  1433                 name:'cmd aux shuffler';
  1436 "/                beSystemProcess;
  1434 "/                beSystemProcess;
  1437 		resume.
  1435                 resume.
  1438     ].
  1436     ].
  1439 
  1437 
  1440     stopShufflers := [:shuffleRest |
  1438     stopShufflers := [:shuffleRest |
  1441 	    inputShufflerProcess notNil ifTrue:[
  1439             inputShufflerProcess notNil ifTrue:[
  1442 		terminateLock critical:[inputShufflerProcess terminate].
  1440                 terminateLock critical:[inputShufflerProcess terminate].
  1443 		inputShufflerProcess waitUntilTerminated
  1441                 inputShufflerProcess waitUntilTerminated
  1444 	    ].
  1442             ].
  1445 	    auxShufflerProcess notNil ifTrue:[
  1443             auxShufflerProcess notNil ifTrue:[
  1446 		terminateLock critical:[auxShufflerProcess terminate].
  1444                 terminateLock critical:[auxShufflerProcess terminate].
  1447 		auxShufflerProcess waitUntilTerminated
  1445                 auxShufflerProcess waitUntilTerminated
  1448 	    ].
  1446             ].
  1449 	    outputShufflerProcess notNil ifTrue:[
  1447             outputShufflerProcess notNil ifTrue:[
  1450 		terminateLock critical:[outputShufflerProcess terminate].
  1448                 terminateLock critical:[outputShufflerProcess terminate].
  1451 		outputShufflerProcess waitUntilTerminated.
  1449                 outputShufflerProcess waitUntilTerminated.
  1452 		shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
  1450                 shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
  1453 		shuffledOutStream close.
  1451                 shuffledOutStream close.
  1454 	    ].
  1452             ].
  1455 	    errorShufflerProcess notNil ifTrue:[
  1453             errorShufflerProcess notNil ifTrue:[
  1456 		terminateLock critical:[errorShufflerProcess terminate].
  1454                 terminateLock critical:[errorShufflerProcess terminate].
  1457 		errorShufflerProcess waitUntilTerminated.
  1455                 errorShufflerProcess waitUntilTerminated.
  1458 		shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
  1456                 shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
  1459 		shuffledErrStream close.
  1457                 shuffledErrStream close.
  1460 	    ].
  1458             ].
  1461 	].
  1459         ].
  1462 
  1460 
  1463     closeStreams := [
  1461     closeStreams := [
  1464 	    inStreamToClose notNil ifTrue:[
  1462             inStreamToClose notNil ifTrue:[
  1465 		inStreamToClose close
  1463                 inStreamToClose close
  1466 	    ].
  1464             ].
  1467 	    errStreamToClose notNil ifTrue:[
  1465             errStreamToClose notNil ifTrue:[
  1468 		errStreamToClose close
  1466                 errStreamToClose close
  1469 	    ].
  1467             ].
  1470 	    outStreamToClose notNil ifTrue:[
  1468             outStreamToClose notNil ifTrue:[
  1471 		outStreamToClose close
  1469                 outStreamToClose close
  1472 	    ].
  1470             ].
  1473 	    auxStreamToClose notNil ifTrue:[
  1471             auxStreamToClose notNil ifTrue:[
  1474 		auxStreamToClose close
  1472                 auxStreamToClose close
  1475 	    ].
  1473             ].
  1476 	    nullStream notNil ifTrue:[
  1474             nullStream notNil ifTrue:[
  1477 		nullStream close
  1475                 nullStream close
  1478 	    ].
  1476             ].
  1479 	].
  1477         ].
  1480 
  1478 
  1481 
  1479 
  1482     sema := Semaphore new name:'OS command wait'.
  1480     sema := Semaphore new name:'OS command wait'.
  1483     [
  1481     [
  1484 	externalInStream isNil ifTrue:[
  1482         externalInStream isNil ifTrue:[
  1485 	    externalInStream := nullStream := Filename nullDevice readWriteStream.
  1483             externalInStream := nullStream := Filename nullDevice readWriteStream.
  1486 	].
  1484         ].
  1487 	externalOutStream isNil ifTrue:[
  1485         externalOutStream isNil ifTrue:[
  1488 	    nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
  1486             nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
  1489 	    externalOutStream := nullStream.
  1487             externalOutStream := nullStream.
  1490 	].
  1488         ].
  1491 	externalErrStream isNil ifTrue:[
  1489         externalErrStream isNil ifTrue:[
  1492 	    externalErrStream := externalOutStream
  1490             externalErrStream := externalOutStream
  1493 	].
  1491         ].
  1494 
  1492 
  1495 	pid := Processor
  1493         pid := Processor
  1496 		    monitor:[
  1494                     monitor:[
  1497 			self
  1495                         self
  1498 			    startProcess:aCommandStringOrArray
  1496                             startProcess:aCommandStringOrArray
  1499 			    inputFrom:externalInStream
  1497                             inputFrom:externalInStream
  1500 			    outputTo:externalOutStream
  1498                             outputTo:externalOutStream
  1501 			    errorTo:externalErrStream
  1499                             errorTo:externalErrStream
  1502 			    auxFrom:externalAuxStream
  1500                             auxFrom:externalAuxStream
  1503 			    environment:environmentDictionary
  1501                             environment:environmentDictionary
  1504 			    inDirectory:dirOrNil
  1502                             inDirectory:dirOrNil
  1505 		    ]
  1503                     ]
  1506 		    action:[:status |
  1504                     action:[:status |
  1507 			status stillAlive ifFalse:[
  1505                         status stillAlive ifFalse:[
  1508 			    exitStatus := status.
  1506                             exitStatus := status.
  1509 			    sema signal.
  1507                             sema signal.
  1510 			    self closePid:pid
  1508                             self closePid:pid
  1511 			]
  1509                         ]
  1512 		    ].
  1510                     ].
  1513 
  1511 
  1514 	pid isNil ifTrue:[
  1512         pid isNil ifTrue:[
  1515 	    exitStatus := self osProcessStatusClass processCreationFailure
  1513             exitStatus := self osProcessStatusClass processCreationFailure
  1516 	] ifFalse:[
  1514         ] ifFalse:[
  1517 	    sema wait.
  1515             sema wait.
  1518 	].
  1516         ].
  1519     ] ifCurtailed:[
  1517     ] ifCurtailed:[
  1520 	closeStreams value.
  1518         closeStreams value.
  1521 	pid notNil ifTrue:[
  1519         pid notNil ifTrue:[
  1522 	    "/ terminate the os-command (and all of its forked commands)
  1520             "/ terminate the os-command (and all of its forked commands)
  1523 	    self terminateProcessGroup:pid.
  1521             self terminateProcessGroup:pid.
  1524 	    self terminateProcess:pid.
  1522             self terminateProcess:pid.
  1525 	    self closePid:pid.
  1523             self closePid:pid.
  1526 	].
  1524         ].
  1527 	stopShufflers value:false.
  1525         stopShufflers value:false.
  1528     ].
  1526     ].
  1529 
  1527 
  1530     closeStreams value.
  1528     closeStreams value.
  1531     stopShufflers value:true.
  1529     stopShufflers value:true.
  1532     (exitStatus isNil or:[exitStatus success]) ifFalse:[
  1530     (exitStatus isNil or:[exitStatus success]) ifFalse:[
  1533 	^ aBlock value:exitStatus
  1531         ^ aBlock value:exitStatus
  1534     ].
  1532     ].
  1535     ^ true
  1533     ^ true
  1536 
  1534 
  1537     "
  1535     "
  1538 	|outStream errStream|
  1536         |outStream errStream|
  1539 
  1537 
  1540 	outStream := '' writeStream.
  1538         outStream := '' writeStream.
  1541 
  1539 
  1542 	OperatingSystem executeCommand:'ls -l'
  1540         OperatingSystem executeCommand:'ls -l'
  1543 			inputFrom:'abc' readStream
  1541                         inputFrom:'abc' readStream
  1544 			outputTo:outStream
  1542                         outputTo:outStream
  1545 			errorTo:nil
  1543                         errorTo:nil
  1546 			inDirectory:nil
  1544                         inDirectory:nil
  1547 			lineWise:true
  1545                         lineWise:true
  1548 			onError:[:exitStatus | ^ false].
  1546                         onError:[:exitStatus | ^ false].
  1549 	outStream contents
  1547         outStream contents
  1550     "
  1548     "
  1551 
  1549 
  1552     "
  1550     "
  1553 	|outStream errStream|
  1551         |outStream errStream|
  1554 
  1552 
  1555 	outStream := #[] writeStream.
  1553         outStream := #[] writeStream.
  1556 
  1554 
  1557 	OperatingSystem executeCommand:'cat'
  1555         OperatingSystem executeCommand:'cat'
  1558 			inputFrom:(ByteArray new:5000000) readStream
  1556                         inputFrom:(ByteArray new:5000000) readStream
  1559 			outputTo:outStream
  1557                         outputTo:outStream
  1560 			errorTo:nil
  1558                         errorTo:nil
  1561 			inDirectory:nil
  1559                         inDirectory:nil
  1562 			lineWise:false
  1560                         lineWise:false
  1563 			onError:[:exitStatus | ^ false].
  1561                         onError:[:exitStatus | ^ false].
  1564 	outStream size
  1562         outStream size
  1565     "
  1563     "
  1566 
  1564 
  1567     "
  1565     "
  1568 	|outStream errStream|
  1566         |outStream errStream|
  1569 
  1567 
  1570 	outStream := '' writeStream.
  1568         outStream := '' writeStream.
  1571 
  1569 
  1572 	OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
  1570         OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
  1573 			inputFrom:'bla' readStream
  1571                         inputFrom:'bla' readStream
  1574 			outputTo:outStream
  1572                         outputTo:outStream
  1575 			errorTo:nil
  1573                         errorTo:nil
  1576 			inDirectory:nil
  1574                         inDirectory:nil
  1577 			lineWise:true
  1575                         lineWise:true
  1578 			onError:[:exitStatus |  false].
  1576                         onError:[:exitStatus |  false].
  1579 	outStream contents
  1577         outStream contents
  1580     "
  1578     "
  1581 
  1579 
  1582     "Modified: / 11-02-2007 / 20:54:39 / cg"
  1580     "Modified: / 11-02-2007 / 20:54:39 / cg"
  1583 !
  1581 !
  1584 
  1582 
  7741 ! !
  7739 ! !
  7742 
  7740 
  7743 !AbstractOperatingSystem class methodsFor:'documentation'!
  7741 !AbstractOperatingSystem class methodsFor:'documentation'!
  7744 
  7742 
  7745 version
  7743 version
  7746     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $'
  7744     ^ '$Header$'
  7747 !
  7745 !
  7748 
  7746 
  7749 version_CVS
  7747 version_CVS
  7750     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $'
  7748     ^ '$Header$'
  7751 ! !
  7749 ! !
  7752 
  7750 
  7753 
  7751 
  7754 AbstractOperatingSystem initialize!
  7752 AbstractOperatingSystem initialize!