diff options
Diffstat (limited to 'ghc/misc/examples/posix')
| -rw-r--r-- | ghc/misc/examples/posix/po001/Main.hs | 23 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po002/Main.hs | 4 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po003/Main.hs | 5 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po004/Main.hs | 58 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po005/Main.hs | 30 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po006/Main.hs | 14 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po007/Main.hs | 31 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po008/Main.hs | 12 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po009/Main.hs | 14 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po010/Main.hs | 24 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po011/Main.hs | 22 | ||||
| -rw-r--r-- | ghc/misc/examples/posix/po012/Main.hs | 52 |
12 files changed, 289 insertions, 0 deletions
diff --git a/ghc/misc/examples/posix/po001/Main.hs b/ghc/misc/examples/posix/po001/Main.hs new file mode 100644 index 0000000000..db10babaa4 --- /dev/null +++ b/ghc/misc/examples/posix/po001/Main.hs @@ -0,0 +1,23 @@ +import LibPosix + +main = + getParentProcessID >>= \ ppid -> + getProcessID >>= \ pid -> + putStr "Parent Process ID: " >> + putText ppid >> + putStr "\nProcess ID: " >> + putText pid >> + putStr "\nforking ps uxww" >> + putText ppid >> + putChar '\n' >> + forkProcess >>= \ child -> + case child of + Nothing -> executeFile "ps" True ["uxww" ++ show ppid] Nothing + Just x -> doParent x pid + +doParent cpid pid = + getProcessStatus True False cpid >> + putStr "\nChild finished. Now exec'ing ps uxww" >> + putText pid >> + putChar '\n' >> + executeFile "ps" True ["uxww" ++ show pid] Nothing diff --git a/ghc/misc/examples/posix/po002/Main.hs b/ghc/misc/examples/posix/po002/Main.hs new file mode 100644 index 0000000000..e646f02839 --- /dev/null +++ b/ghc/misc/examples/posix/po002/Main.hs @@ -0,0 +1,4 @@ +import LibPosix + +main = + executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")]) diff --git a/ghc/misc/examples/posix/po003/Main.hs b/ghc/misc/examples/posix/po003/Main.hs new file mode 100644 index 0000000000..b05d9cf7f0 --- /dev/null +++ b/ghc/misc/examples/posix/po003/Main.hs @@ -0,0 +1,5 @@ +import LibPosix + +main = + openFile "po003.out" WriteMode >>= \ h -> + runProcess "pwd" [] Nothing (Just "/usr/tmp") Nothing (Just h) Nothing
\ No newline at end of file diff --git a/ghc/misc/examples/posix/po004/Main.hs b/ghc/misc/examples/posix/po004/Main.hs new file mode 100644 index 0000000000..1725dd4e2b --- /dev/null +++ b/ghc/misc/examples/posix/po004/Main.hs @@ -0,0 +1,58 @@ +import LibPosix +import LibSystem(ExitCode(..), exitWith) + +main = + forkProcess >>= \ maybe_pid -> + case maybe_pid of + Nothing -> raiseSignal floatingPointException + _ -> doParent + +doParent = + getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> + case tc of + Terminated sig | sig == floatingPointException -> forkChild2 + _ -> fail "unexpected termination cause" + +forkChild2 = + forkProcess >>= \ maybe_pid -> + case maybe_pid of + Nothing -> exitImmediately (ExitFailure 42) + _ -> doParent2 + +doParent2 = + getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> + case tc of + Exited (ExitFailure 42) -> forkChild3 + _ -> fail "unexpected termination cause (2)" + +forkChild3 = + forkProcess >>= \ maybe_pid -> + case maybe_pid of + Nothing -> exitImmediately (ExitSuccess) + _ -> doParent3 + +doParent3 = + getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> + case tc of + Exited ExitSuccess -> forkChild4 + _ -> fail "unexpected termination cause (3)" + +forkChild4 = + forkProcess >>= \ maybe_pid -> + case maybe_pid of + Nothing -> raiseSignal softwareStop + _ -> doParent4 + +doParent4 = + getAnyProcessStatus True True >>= \ (Just (pid, tc)) -> + case tc of + Stopped sig | sig == softwareStop -> enoughAlready pid + _ -> fail "unexpected termination cause (4)" + +enoughAlready pid = + signalProcess killProcess pid >> + getAnyProcessStatus True True >>= \ (Just (pid, tc)) -> + case tc of + Terminated sig | sig == killProcess -> putStr "I'm happy.\n" + _ -> fail "unexpected termination cause (5)" + diff --git a/ghc/misc/examples/posix/po005/Main.hs b/ghc/misc/examples/posix/po005/Main.hs new file mode 100644 index 0000000000..8ea76255e1 --- /dev/null +++ b/ghc/misc/examples/posix/po005/Main.hs @@ -0,0 +1,30 @@ +import LibPosix + +main = + getEnvVar "TERM" >>= \ term -> + putStr term >> + putChar '\n' >> + setEnvironment [("one","1"),("two","2")] >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' >> + setEnvVar "foo" "bar" >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' >> + setEnvVar "foo" "baz" >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' >> + setEnvVar "fu" "bar" >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' >> + removeEnvVar "foo" >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' >> + setEnvironment [] >> + getEnvironment >>= \ env -> + putText env >> + putChar '\n' diff --git a/ghc/misc/examples/posix/po006/Main.hs b/ghc/misc/examples/posix/po006/Main.hs new file mode 100644 index 0000000000..8008a50f2b --- /dev/null +++ b/ghc/misc/examples/posix/po006/Main.hs @@ -0,0 +1,14 @@ +import LibPosix + +main = + epochTime >>= \ start -> + sleep 5 >> + let timeleft = 0 in + epochTime >>= \ finish -> + putStr "Started: " >> + putText start >> + putStr "\nSlept: " >> + putText (5 - timeleft) >> + putStr "\nFinished: " >> + putText finish >> + putChar '\n' diff --git a/ghc/misc/examples/posix/po007/Main.hs b/ghc/misc/examples/posix/po007/Main.hs new file mode 100644 index 0000000000..d70e913e6b --- /dev/null +++ b/ghc/misc/examples/posix/po007/Main.hs @@ -0,0 +1,31 @@ +import LibPosix + +main = + installHandler keyboardSignal (Catch doCtrlC) Nothing >> + getTerminalAttributes stdInput >>= \ ta -> + case (controlChar ta Interrupt) of + Nothing -> fixMe ta + Just x -> continue x + +fixMe ta = + putStr "Oops...no interrupt character?\nI can fix that...\n" >> + setTerminalAttributes stdInput (withCC ta (Interrupt, '\ETX')) Immediately >> + getTerminalAttributes stdInput >>= \ ta -> + case (controlChar ta Interrupt) of + Nothing -> putStr "...Then again, maybe I can't\n" + Just x -> continue x + +continue x = + putStr "Press '" >> + putStr (ccStr x) >> + putStr "'.\n" >> + awaitSignal Nothing >> + putStr "How did I get here?\n" + +doCtrlC = + putStr "Caught an interrupt.\n" + +ccStr '\DEL' = "^?" +ccStr x + | x >= ' ' = [x] + | otherwise = ['^', (chr (ord x + ord '@'))] diff --git a/ghc/misc/examples/posix/po008/Main.hs b/ghc/misc/examples/posix/po008/Main.hs new file mode 100644 index 0000000000..c775064405 --- /dev/null +++ b/ghc/misc/examples/posix/po008/Main.hs @@ -0,0 +1,12 @@ +import LibPosix + +main = + installHandler realTimeAlarm (Catch alarmclock) Nothing >> + putStr "Scheduling an alarm in 5 seconds...\n" >> + scheduleAlarm 5 >> + putStr "Sleeping one minute.\n" >> + sleep 60 >> + putStr "How did I get here?\n" + +alarmclock = + putStr "The alarm went off.\n" diff --git a/ghc/misc/examples/posix/po009/Main.hs b/ghc/misc/examples/posix/po009/Main.hs new file mode 100644 index 0000000000..9707c58747 --- /dev/null +++ b/ghc/misc/examples/posix/po009/Main.hs @@ -0,0 +1,14 @@ +import LibPosix + +main = + putStr "Blocking real time alarms.\n" >> + blockSignals (addSignal realTimeAlarm emptySignalSet) >> + putStr "Scheduling an alarm in 2 seconds...\n" >> + scheduleAlarm 2 >> + putStr "Sleeping 5 seconds.\n" >> + sleep 5 >> + getPendingSignals >>= \ ints -> + putStr "Checking pending interrupts for RealTimeAlarm\n" >> + putText (inSignalSet realTimeAlarm ints) >> + putChar '\n' + diff --git a/ghc/misc/examples/posix/po010/Main.hs b/ghc/misc/examples/posix/po010/Main.hs new file mode 100644 index 0000000000..bfc890941f --- /dev/null +++ b/ghc/misc/examples/posix/po010/Main.hs @@ -0,0 +1,24 @@ +import LibPosix + +main = + getUserEntryForName "mattson" >>= \ mattson -> + getUserEntryForName "partain" >>= \ partain -> + putStr (ue2String mattson) >> + putChar '\n' >> + putStr (ue2String partain) >> + putChar '\n' >> + getUserEntryForID (userID mattson) >>= \ muid -> + getUserEntryForID (userID partain) >>= \ puid -> + putStr (ue2String muid) >> + putChar '\n' >> + putStr (ue2String puid) >> + putChar '\n' + +ue2String ue = + name ++ (':' : (show uid) ++ (':' : (show gid) ++ (':' : home ++ (':' : shell)))) + where + name = userName ue + uid = userID ue + gid = userGroupID ue + home = homeDirectory ue + shell = userShell ue
\ No newline at end of file diff --git a/ghc/misc/examples/posix/po011/Main.hs b/ghc/misc/examples/posix/po011/Main.hs new file mode 100644 index 0000000000..3d78924157 --- /dev/null +++ b/ghc/misc/examples/posix/po011/Main.hs @@ -0,0 +1,22 @@ +import LibPosix + +main = + getGroupEntryForName "grasp" >>= \ grasp -> + getGroupEntryForName "staff" >>= \ staff -> + putStr (ge2String grasp) >> + putChar '\n' >> + putStr (ge2String staff) >> + putChar '\n' >> + getGroupEntryForID (groupID grasp) >>= \ guid -> + getGroupEntryForID (groupID staff) >>= \ suid -> + putStr (ge2String guid) >> + putChar '\n' >> + putStr (ge2String suid) >> + putChar '\n' + +ge2String ge = + name ++ (':' : (show gid) ++ (':' : members)) + where + name = groupName ge + gid = groupID ge + members = foldr (\x y -> x ++ (',' : y)) "" (groupMembers ge)
\ No newline at end of file diff --git a/ghc/misc/examples/posix/po012/Main.hs b/ghc/misc/examples/posix/po012/Main.hs new file mode 100644 index 0000000000..d4eb3841bf --- /dev/null +++ b/ghc/misc/examples/posix/po012/Main.hs @@ -0,0 +1,52 @@ +import LibPosix + +main = + createFile "po012.out" stdFileMode >>= \ fd -> + installHandler processStatusChanged (Catch (reap1 fd)) Nothing >> + ls >> + awaitSignal Nothing + +ls = + runProcess "ls" ["-l","po012.out"] Nothing Nothing Nothing Nothing Nothing + +reap1 fd = + getAnyProcessStatus True False >> + installHandler processStatusChanged (Catch (reap2 fd)) Nothing >> + writeChannel fd (take 666 (repeat 'x')) >> + ls >> + awaitSignal Nothing + +reap2 fd = + getAnyProcessStatus True False >> + installHandler processStatusChanged (Catch (reap3 fd)) Nothing >> + setFileMode "po012.out" + (foldr1 unionFileModes [ownerReadMode,ownerWriteMode,groupReadMode,otherReadMode]) >> + ls >> + awaitSignal Nothing + +reap3 fd = + getAnyProcessStatus True False >> + installHandler processStatusChanged (Catch (reap4 fd)) Nothing >> + setFileTimes "po012.out" 0 0 >> + ls >> + awaitSignal Nothing + +reap4 fd = + getAnyProcessStatus True False >> + installHandler processStatusChanged (Catch (reap5 fd)) Nothing >> + removeLink "po012.out" >> + ls >> + awaitSignal Nothing + +reap5 fd = + getAnyProcessStatus True False >> + seekChannel fd SeekFromEnd 0 >>= \ bytes -> + if bytes == 666 then + seekChannel fd AbsoluteSeek 0 >> + readChannel fd 1024 >>= \ (str, _) -> + if str == (take 666 (repeat 'x')) then + putStr "Okay\n" + else + putStr "Read failed\n" + else + putStr "Seek returned wrong size\n" |