AbstractOperatingSystem.st
changeset 17362 c07512e3643c
parent 17178 623ad6fc9dca
child 17431 bab67ea3bf22
equal deleted inserted replaced
17361:ab3b25502ca4 17362:c07512e3643c
     8  be provided or otherwise made available to, or used by, any
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 "{ Package: 'stx:libbasic' }"
    12 "{ Package: 'stx:libbasic' }"
       
    13 
       
    14 "{ NameSpace: Smalltalk }"
    13 
    15 
    14 Object subclass:#AbstractOperatingSystem
    16 Object subclass:#AbstractOperatingSystem
    15 	instanceVariableNames:''
    17 	instanceVariableNames:''
    16 	classVariableNames:'ConcreteClass LastErrorNumber LocaleInfo OSSignals PipeFailed
    18 	classVariableNames:'ConcreteClass LastErrorNumber LocaleInfo OSSignals PipeFailed
    17 		ErrorSignal AccessDeniedErrorSignal FileNotFoundErrorSignal
    19 		ErrorSignal AccessDeniedErrorSignal FileNotFoundErrorSignal
  1311      Nil stream args will execute the command connected to ST/X's standard input, output or
  1313      Nil stream args will execute the command connected to ST/X's standard input, output or
  1312      error resp. - i.e. usually, i/o will be from/to the terminal.
  1314      error resp. - i.e. usually, i/o will be from/to the terminal.
  1313 
  1315 
  1314      Set lineWise to true, if both error and output is sent to the same stream
  1316      Set lineWise to true, if both error and output is sent to the same stream
  1315      and you don't want lines to be mangled. Set lineWise = false to
  1317      and you don't want lines to be mangled. Set lineWise = false to
  1316      avoid vlocking on pipes"
  1318      avoid blocking on pipes"
  1317 
  1319 
  1318     |pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
  1320     |pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
  1319      shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
  1321      shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
  1320      inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
  1322      inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
  1321      inStreamToClose outStreamToClose errStreamToClose auxStreamToClose terminateLock
  1323      inStreamToClose outStreamToClose errStreamToClose auxStreamToClose nullStream terminateLock
  1322      closeStreams|
  1324      closeStreams|
  1323 
  1325 
  1324     terminateLock := Semaphore forMutualExclusion.
  1326     terminateLock := Semaphore forMutualExclusion.
  1325     ((externalInStream := anInStream) notNil
  1327     ((externalInStream := anInStream) notNil
  1326      and:[externalInStream isExternalStream not]) ifTrue:[
  1328      and:[externalInStream isExternalStream not]) ifTrue:[
  1327 	pIn := NonPositionableExternalStream makePipe.
  1329         pIn := NonPositionableExternalStream makePipe.
  1328 	inStreamToClose := externalInStream := pIn at:1.
  1330         inStreamToClose := externalInStream := pIn at:1.
  1329 	shuffledInStream := pIn at:2.
  1331         shuffledInStream := pIn at:2.
  1330 	anInStream isBinary ifTrue:[
  1332         anInStream isBinary ifTrue:[
  1331 	    shuffledInStream binary
  1333             shuffledInStream binary
  1332 	].
  1334         ].
  1333 	lineWise ifFalse:[
  1335         lineWise ifFalse:[
  1334 	    shuffledInStream blocking:false.
  1336             shuffledInStream blocking:false.
  1335 	].
  1337         ].
  1336 
  1338 
  1337 	"/ start a reader process, shuffling data from the given
  1339         "/ start a reader process, shuffling data from the given
  1338 	"/ inStream to the pipe (which is connected to the commands input)
  1340         "/ inStream to the pipe (which is connected to the commands input)
  1339 	inputShufflerProcess :=
  1341         inputShufflerProcess :=
  1340 	    [
  1342             [
  1341 		[
  1343                 [
  1342 		    [anInStream atEnd] whileFalse:[
  1344                     [anInStream atEnd] whileFalse:[
  1343 			self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
  1345                         self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
  1344 			shuffledInStream flush
  1346                         shuffledInStream flush
  1345 		    ]
  1347                     ]
  1346 		] ensure:[
  1348                 ] ensure:[
  1347 		    shuffledInStream close
  1349                     shuffledInStream close
  1348 		]
  1350                 ]
  1349 	    ] newProcess
  1351             ] newProcess
  1350 		name:'cmd input shuffler';
  1352                 name:'cmd input shuffler';
  1351 "/                beSystemProcess;
  1353 "/                beSystemProcess;
  1352 		resume.
  1354                 resume.
  1353     ].
  1355     ].
  1354     ((externalOutStream := anOutStream) notNil
  1356     ((externalOutStream := anOutStream) notNil
  1355      and:[externalOutStream isExternalStream not]) ifTrue:[
  1357      and:[externalOutStream isExternalStream not]) ifTrue:[
  1356 	pOut := NonPositionableExternalStream makePipe.
  1358         pOut := NonPositionableExternalStream makePipe.
  1357 	shuffledOutStream := (pOut at:1).
  1359         shuffledOutStream := (pOut at:1).
  1358 	anOutStream isBinary ifTrue:[
  1360         anOutStream isBinary ifTrue:[
  1359 	    shuffledOutStream binary
  1361             shuffledOutStream binary
  1360 	].
  1362         ].
  1361 	outStreamToClose := externalOutStream := pOut at:2.
  1363         outStreamToClose := externalOutStream := pOut at:2.
  1362 	outputShufflerProcess :=
  1364         outputShufflerProcess :=
  1363 	    [
  1365             [
  1364 		WriteError handle:[:ex |
  1366                 WriteError handle:[:ex |
  1365 		    "/ ignored
  1367                     "/ ignored
  1366 		] do:[
  1368                 ] do:[
  1367 		    self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
  1369                     self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
  1368 		].
  1370                 ].
  1369 	    ] newProcess
  1371             ] newProcess
  1370 		priority:(Processor userSchedulingPriority + 1);
  1372                 priority:(Processor userSchedulingPriority + 1);
  1371 		name:'cmd output shuffler';
  1373                 name:'cmd output shuffler';
  1372 "/                beSystemProcess;
  1374 "/                beSystemProcess;
  1373 		resume.
  1375                 resume.
  1374     ].
  1376     ].
  1375     (externalErrStream := anErrStream) notNil ifTrue:[
  1377     (externalErrStream := anErrStream) notNil ifTrue:[
  1376 	anErrStream == anOutStream ifTrue:[
  1378         anErrStream == anOutStream ifTrue:[
  1377 	    externalErrStream := externalOutStream
  1379             externalErrStream := externalOutStream
  1378 	] ifFalse:[
  1380         ] ifFalse:[
  1379 	    anErrStream isExternalStream ifFalse:[
  1381             anErrStream isExternalStream ifFalse:[
  1380 		pErr := NonPositionableExternalStream makePipe.
  1382                 pErr := NonPositionableExternalStream makePipe.
  1381 		shuffledErrStream := (pErr at:1).
  1383                 shuffledErrStream := (pErr at:1).
  1382 		anErrStream isBinary ifTrue:[
  1384                 anErrStream isBinary ifTrue:[
  1383 		    shuffledErrStream binary
  1385                     shuffledErrStream binary
  1384 		].
  1386                 ].
  1385 		errStreamToClose := externalErrStream := pErr at:2.
  1387                 errStreamToClose := externalErrStream := pErr at:2.
  1386 		errorShufflerProcess :=
  1388                 errorShufflerProcess :=
  1387 		    [
  1389                     [
  1388 			self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
  1390                         self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
  1389 		    ] newProcess
  1391                     ] newProcess
  1390 			priority:(Processor userSchedulingPriority + 2);
  1392                         priority:(Processor userSchedulingPriority + 2);
  1391 			name:'cmd err-output shuffler';
  1393                         name:'cmd err-output shuffler';
  1392 "/                        beSystemProcess;
  1394 "/                        beSystemProcess;
  1393 			resume.
  1395                         resume.
  1394 	    ]
  1396             ]
  1395 	]
  1397         ]
  1396     ].
  1398     ].
  1397     ((externalAuxStream := anAuxStream) notNil
  1399     ((externalAuxStream := anAuxStream) notNil
  1398      and:[externalAuxStream isExternalStream not]) ifTrue:[
  1400      and:[externalAuxStream isExternalStream not]) ifTrue:[
  1399 	pAux := NonPositionableExternalStream makePipe.
  1401         pAux := NonPositionableExternalStream makePipe.
  1400 	auxStreamToClose := externalAuxStream := pAux at:1.
  1402         auxStreamToClose := externalAuxStream := pAux at:1.
  1401 	shuffledAuxStream := pAux at:2.
  1403         shuffledAuxStream := pAux at:2.
  1402 	shuffledAuxStream blocking:false.
  1404         shuffledAuxStream blocking:false.
  1403 	anAuxStream isBinary ifTrue:[
  1405         anAuxStream isBinary ifTrue:[
  1404 	    shuffledAuxStream binary
  1406             shuffledAuxStream binary
  1405 	].
  1407         ].
  1406 
  1408 
  1407 	"/ start a reader process, shuffling data from the given
  1409         "/ start a reader process, shuffling data from the given
  1408 	"/ auxStream to the pipe (which is connected to the commands aux)
  1410         "/ auxStream to the pipe (which is connected to the commands aux)
  1409 	auxShufflerProcess :=
  1411         auxShufflerProcess :=
  1410 	    [
  1412             [
  1411 		[
  1413                 [
  1412 		    [anAuxStream atEnd] whileFalse:[
  1414                     [anAuxStream atEnd] whileFalse:[
  1413 			self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
  1415                         self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
  1414 			shuffledAuxStream flush
  1416                         shuffledAuxStream flush
  1415 		    ]
  1417                     ]
  1416 		] ensure:[
  1418                 ] ensure:[
  1417 		    shuffledAuxStream close
  1419                     shuffledAuxStream close
  1418 		]
  1420                 ]
  1419 	    ] newProcess
  1421             ] newProcess
  1420 		name:'cmd aux shuffler';
  1422                 name:'cmd aux shuffler';
  1421 "/                beSystemProcess;
  1423 "/                beSystemProcess;
  1422 		resume.
  1424                 resume.
  1423     ].
  1425     ].
  1424 
  1426 
  1425     stopShufflers := [:shuffleRest |
  1427     stopShufflers := [:shuffleRest |
  1426 	inputShufflerProcess notNil ifTrue:[
  1428             inputShufflerProcess notNil ifTrue:[
  1427 	    terminateLock critical:[inputShufflerProcess terminate].
  1429                 terminateLock critical:[inputShufflerProcess terminate].
  1428 	    inputShufflerProcess waitUntilTerminated
  1430                 inputShufflerProcess waitUntilTerminated
  1429 	].
  1431             ].
  1430 	auxShufflerProcess notNil ifTrue:[
  1432             auxShufflerProcess notNil ifTrue:[
  1431 	    terminateLock critical:[auxShufflerProcess terminate].
  1433                 terminateLock critical:[auxShufflerProcess terminate].
  1432 	    auxShufflerProcess waitUntilTerminated
  1434                 auxShufflerProcess waitUntilTerminated
  1433 	].
  1435             ].
  1434 	outputShufflerProcess notNil ifTrue:[
  1436             outputShufflerProcess notNil ifTrue:[
  1435 	    terminateLock critical:[outputShufflerProcess terminate].
  1437                 terminateLock critical:[outputShufflerProcess terminate].
  1436 	    outputShufflerProcess waitUntilTerminated.
  1438                 outputShufflerProcess waitUntilTerminated.
  1437 	    shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
  1439                 shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
  1438 	    shuffledOutStream close.
  1440                 shuffledOutStream close.
  1439 	].
  1441             ].
  1440 	errorShufflerProcess notNil ifTrue:[
  1442             errorShufflerProcess notNil ifTrue:[
  1441 	    terminateLock critical:[errorShufflerProcess terminate].
  1443                 terminateLock critical:[errorShufflerProcess terminate].
  1442 	    errorShufflerProcess waitUntilTerminated.
  1444                 errorShufflerProcess waitUntilTerminated.
  1443 	    shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
  1445                 shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
  1444 	    shuffledErrStream close.
  1446                 shuffledErrStream close.
  1445 	].
  1447             ].
  1446     ].
  1448         ].
  1447 
  1449 
  1448     closeStreams := [
  1450     closeStreams := [
  1449 	inStreamToClose notNil ifTrue:[
  1451             inStreamToClose notNil ifTrue:[
  1450 	    inStreamToClose close
  1452                 inStreamToClose close
  1451 	].
  1453             ].
  1452 	errStreamToClose notNil ifTrue:[
  1454             errStreamToClose notNil ifTrue:[
  1453 	    errStreamToClose close
  1455                 errStreamToClose close
  1454 	].
  1456             ].
  1455 	outStreamToClose notNil ifTrue:[
  1457             outStreamToClose notNil ifTrue:[
  1456 	    outStreamToClose close
  1458                 outStreamToClose close
  1457 	].
  1459             ].
  1458 	auxStreamToClose notNil ifTrue:[
  1460             auxStreamToClose notNil ifTrue:[
  1459 	    auxStreamToClose close
  1461                 auxStreamToClose close
  1460 	].
  1462             ].
  1461     ].
  1463             nullStream notNil ifTrue:[
       
  1464                 nullStream close
       
  1465             ].
       
  1466         ].
  1462 
  1467 
  1463 
  1468 
  1464     sema := Semaphore new name:'OS command wait'.
  1469     sema := Semaphore new name:'OS command wait'.
  1465     [
  1470     [
  1466 	pid := Processor
  1471         externalInStream isNil ifTrue:[
  1467 		    monitor:[
  1472             externalInStream := nullStream := Filename nullDevice readWriteStream.
  1468 			self
  1473         ].
  1469 			    startProcess:aCommandString
  1474         externalOutStream isNil ifTrue:[
  1470 			    inputFrom:externalInStream
  1475             nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
  1471 			    outputTo:externalOutStream
  1476             externalOutStream := nullStream.
  1472 			    errorTo:externalErrStream
  1477         ].
  1473 			    auxFrom:externalAuxStream
  1478         externalErrStream isNil ifTrue:[
  1474 			    environment:environmentDictionary
  1479             externalErrStream := externalOutStream
  1475 			    inDirectory:dirOrNil
  1480         ].
  1476 		    ]
  1481 
  1477 		    action:[:status |
  1482         pid := Processor
  1478 			status stillAlive ifFalse:[
  1483                     monitor:[
  1479 			    exitStatus := status.
  1484                         self
  1480 			    sema signal.
  1485                             startProcess:aCommandString
  1481 			    self closePid:pid
  1486                             inputFrom:externalInStream
  1482 			]
  1487                             outputTo:externalOutStream
  1483 		    ].
  1488                             errorTo:externalErrStream
  1484 
  1489                             auxFrom:externalAuxStream
  1485 	pid isNil ifTrue:[
  1490                             environment:environmentDictionary
  1486 	    exitStatus := self osProcessStatusClass processCreationFailure
  1491                             inDirectory:dirOrNil
  1487 	] ifFalse:[
  1492                     ]
  1488 	    sema wait.
  1493                     action:[:status |
  1489 	].
  1494                         status stillAlive ifFalse:[
       
  1495                             exitStatus := status.
       
  1496                             sema signal.
       
  1497                             self closePid:pid
       
  1498                         ]
       
  1499                     ].
       
  1500 
       
  1501         pid isNil ifTrue:[
       
  1502             exitStatus := self osProcessStatusClass processCreationFailure
       
  1503         ] ifFalse:[
       
  1504             sema wait.
       
  1505         ].
  1490     ] ifCurtailed:[
  1506     ] ifCurtailed:[
  1491 	closeStreams value.
  1507         closeStreams value.
  1492 	pid notNil ifTrue:[
  1508         pid notNil ifTrue:[
  1493 	    "/ terminate the os-command (and all of its forked commands)
  1509             "/ terminate the os-command (and all of its forked commands)
  1494 	    self terminateProcessGroup:pid.
  1510             self terminateProcessGroup:pid.
  1495 	    self terminateProcess:pid.
  1511             self terminateProcess:pid.
  1496 	    self closePid:pid.
  1512             self closePid:pid.
  1497 	].
  1513         ].
  1498 	stopShufflers value:false.
  1514         stopShufflers value:false.
  1499     ].
  1515     ].
  1500 
  1516 
  1501     closeStreams value.
  1517     closeStreams value.
  1502     stopShufflers value:true.
  1518     stopShufflers value:true.
  1503     (exitStatus isNil or:[exitStatus success]) ifFalse:[
  1519     (exitStatus isNil or:[exitStatus success]) ifFalse:[
  1504 	^ aBlock value:exitStatus
  1520         ^ aBlock value:exitStatus
  1505     ].
  1521     ].
  1506     ^ true
  1522     ^ true
  1507 
  1523 
  1508     "
  1524     "
  1509 	|outStream errStream|
  1525         |outStream errStream|
  1510 
  1526 
  1511 	outStream := '' writeStream.
  1527         outStream := '' writeStream.
  1512 
  1528 
  1513 	OperatingSystem executeCommand:'ls -l'
  1529         OperatingSystem executeCommand:'ls -l'
  1514 			inputFrom:'abc' readStream
  1530                         inputFrom:'abc' readStream
  1515 			outputTo:outStream
  1531                         outputTo:outStream
  1516 			errorTo:nil
  1532                         errorTo:nil
  1517 			inDirectory:nil
  1533                         inDirectory:nil
  1518 			lineWise:true
  1534                         lineWise:true
  1519 			onError:[:exitStatus | ^ false].
  1535                         onError:[:exitStatus | ^ false].
  1520 	outStream contents
  1536         outStream contents
  1521     "
  1537     "
  1522 
  1538 
  1523     "
  1539     "
  1524 	|outStream errStream|
  1540         |outStream errStream|
  1525 
  1541 
  1526 	outStream := #[] writeStream.
  1542         outStream := #[] writeStream.
  1527 
  1543 
  1528 	OperatingSystem executeCommand:'cat'
  1544         OperatingSystem executeCommand:'cat'
  1529 			inputFrom:(ByteArray new:5000000) readStream
  1545                         inputFrom:(ByteArray new:5000000) readStream
  1530 			outputTo:outStream
  1546                         outputTo:outStream
  1531 			errorTo:nil
  1547                         errorTo:nil
  1532 			inDirectory:nil
  1548                         inDirectory:nil
  1533 			lineWise:false
  1549                         lineWise:false
  1534 			onError:[:exitStatus | ^ false].
  1550                         onError:[:exitStatus | ^ false].
  1535 	outStream size
  1551         outStream size
  1536     "
  1552     "
  1537 
  1553 
  1538     "
  1554     "
  1539 	|outStream errStream|
  1555         |outStream errStream|
  1540 
  1556 
  1541 	outStream := '' writeStream.
  1557         outStream := '' writeStream.
  1542 
  1558 
  1543 	OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
  1559         OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
  1544 			inputFrom:'bla' readStream
  1560                         inputFrom:'bla' readStream
  1545 			outputTo:outStream
  1561                         outputTo:outStream
  1546 			errorTo:nil
  1562                         errorTo:nil
  1547 			inDirectory:nil
  1563                         inDirectory:nil
  1548 			lineWise:true
  1564                         lineWise:true
  1549 			onError:[:exitStatus |  false].
  1565                         onError:[:exitStatus |  false].
  1550 	outStream contents
  1566         outStream contents
  1551     "
  1567     "
  1552 
  1568 
  1553     "Modified: / 11-02-2007 / 20:54:39 / cg"
  1569     "Modified: / 11-02-2007 / 20:54:39 / cg"
  1554 !
  1570 !
  1555 
  1571 
  7646 ! !
  7662 ! !
  7647 
  7663 
  7648 !AbstractOperatingSystem class methodsFor:'documentation'!
  7664 !AbstractOperatingSystem class methodsFor:'documentation'!
  7649 
  7665 
  7650 version
  7666 version
  7651     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.287 2014-12-03 19:26:20 cg Exp $'
  7667     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.288 2015-02-02 16:26:18 stefan Exp $'
  7652 !
  7668 !
  7653 
  7669 
  7654 version_CVS
  7670 version_CVS
  7655     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.287 2014-12-03 19:26:20 cg Exp $'
  7671     ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.288 2015-02-02 16:26:18 stefan Exp $'
  7656 ! !
  7672 ! !
  7657 
  7673 
  7658 
  7674 
  7659 AbstractOperatingSystem initialize!
  7675 AbstractOperatingSystem initialize!