第二十章：使用 Haskell 進(jìn)行系統(tǒng)編程
第二十章：使用 Haskell 進(jìn)行系統(tǒng)編程
目前為止，我們討論的大多數(shù)是高階概念。 Haskell 也可以用于底層系統(tǒng)編程。完全可以使用 Haskell 編寫使用操作系統(tǒng)底層接口的程序。
本章中，我們將嘗試一些很有野心的東西：編寫一種類似 Perl 實際上是合法的 Haskell 的“語言”，完全使用 Haskell 實現(xiàn)，用于簡化編寫 shell 腳本。我們將實現(xiàn)管道，簡單命令調(diào)用，和一些簡單的工具用于執(zhí)行由 grep 和 sed 處理的任務(wù)。
有些模塊是依賴操作系統(tǒng)的。本章中，我們將盡可能使用不依賴特殊操作系統(tǒng)的通用模塊。不過，本章將有很多內(nèi)容著眼于 POSIX 環(huán)境。 POSIX 是一種類 Unix 標(biāo)準(zhǔn)， 如 Linux ，F(xiàn)reeBSD ，MacOS X ，或 Solaris 。Windows 默認(rèn)情況下不支持 POSIX ，但是 Cygwin 環(huán)境為 Windows 提供了 POSIX 兼容層。
調(diào)用外部程序
Haskell 可以調(diào)用外部命令。為了這么做，我們建議使用 System.Cmd 模塊中的 rawSystem 。其用特定的參數(shù)調(diào)用特定的程序，并將返回程序的退出狀態(tài)碼。你可以在 ghci 中練習(xí)一下。
ghci> :module System.Cmd
ghci> rawSystem "ls" ["-l", "/usr"]
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Loading package unix-2.3.0.0 ... linking ... done.
Loading package process-1.0.0.0 ... linking ... done.
total 124
drwxr-xr-x 2 root root 49152 2008-08-18 11:04 bin
drwxr-xr-x 2 root root 4096 2008-03-09 05:53 games
drwxr-sr-x 10 jimb guile 4096 2006-02-04 09:13 guile
drwxr-xr-x 47 root root 8192 2008-08-08 08:18 include
drwxr-xr-x 107 root root 32768 2008-08-18 11:04 lib
lrwxrwxrwx 1 root root 3 2007-09-24 16:55 lib64 -> lib
drwxrwsr-x 17 root staff 4096 2008-06-24 17:35 local
drwxr-xr-x 2 root root 8192 2008-08-18 11:03 sbin
drwxr-xr-x 181 root root 8192 2008-08-12 10:11 share
drwxrwsr-x 2 root src 4096 2007-04-10 16:28 src
drwxr-xr-x 3 root root 4096 2008-07-04 19:03 X11R6
ExitSuccess
此處，我們相當(dāng)于執(zhí)行了 shell 命令 ls-l/usr 。 rawSystem 并不從字符串解析輸入?yún)?shù)或是擴展通配符 [43] 。取而代之，其接受一個包含所有參數(shù)的列表。如果不想提供參數(shù)，可以像這樣簡單地輸入一個空列表。
ghci> rawSystem "ls" []
calendartime.ghci modtime.ghci rp.ghci RunProcessSimple.hs
cmd.ghci posixtime.hs rps.ghci timediff.ghci
dir.ghci rawSystem.ghci RunProcess.hs time.ghci
ExitSuccess
目錄和文件信息
System.Directory 模塊包含了相當(dāng)多可以從文件系統(tǒng)獲取信息的函數(shù)。你可以獲取某目錄包含的文件列表，重命名或刪除文件，復(fù)制文件，改變當(dāng)前工作路徑，或者建立新目錄。 System.Directory 是可移植的，在可以跑 GHC 的平臺都可以使用。
System.Directory 的庫文檔 [http://hackage.haskell.org/package/directory-1.0.0.0/docs/System-Directory.html] 中含有一份詳盡的函數(shù)列表。讓我們通過 ghci 來對其中一些進(jìn)行演示。這些函數(shù)大多數(shù)簡單的等價于其對應(yīng)的 C 語言庫函數(shù)或 shell 命令。
ghci> :module System.Directory
ghci> setCurrentDirectory "/etc"
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
ghci> getCurrentDirectory
"/etc"
ghci> setCurrentDirectory ".."
ghci> getCurrentDirectory
"/"
此處我們看到了改變工作目錄和獲取當(dāng)前工作目錄的命令。它們類似 POSIX shell 中的 cd 和 pwd 命令。
ghci> getDirectoryContents "/"
[".","..","lost+found","boot","etc","media","initrd.img","var","usr","bin","dev","home","lib","mnt","proc","root","sbin","tmp","sys","lib64","srv","opt","initrd","vmlinuz",".rnd","www","ultra60","emul",".fonts.cache-1","selinux","razor-agent.log",".svn","initrd.img.old","vmlinuz.old","ugid-survey.bulkdata","ugid-survey.brief"]
getDirectoryContents 返回一個列表，包含給定目錄的所有內(nèi)容。注意，在 POSIX 系統(tǒng)中，這個列表通常包含特殊值 ”.” 和 ”..” 。通常在處理目錄內(nèi)容時，你可能會希望將他們過濾出去，像這樣：
ghci> getDirectoryContents "/" >>= return . filter (`notElem` [".", ".."])
["lost+found","boot","etc","media","initrd.img","var","usr","bin","dev","home","lib","mnt","proc","root","sbin","tmp","sys","lib64","srv","opt","initrd","vmlinuz",".rnd","www","ultra60","emul",".fonts.cache-1","selinux","razor-agent.log",".svn","initrd.img.old","vmlinuz.old","ugid-survey.bulkdata","ugid-survey.brief"]
Tip
更細(xì)致的討論如何過濾 getDirectoryContents 函數(shù)的結(jié)果，請參考 第八章：高效文件處理、正則表達(dá)式、文件名匹配
filter(notElem[".",".."]) 這段代碼是否有點莫名其妙？也可以寫作 filter(c->not$elemc[".",".."]) 。反引號讓我們更有效的將第二個參數(shù)傳給 notElem ；在 “中序函數(shù)” 一節(jié)中有關(guān)于反引號更詳細(xì)的信息。
也可以向系統(tǒng)查詢某些路徑的位置。這將向底層操作系統(tǒng)發(fā)起查詢相關(guān)信息。
ghci> getHomeDirectory
"/home/bos"
ghci> getAppUserDataDirectory "myApp"
"/home/bos/.myApp"
ghci> getUserDocumentsDirectory
"/home/bos"
終止程序
開發(fā)者經(jīng)常編寫?yīng)毩⒌某绦蛞酝瓿商囟ㄈ蝿?wù)。這些獨立的部分可能會被組合起來完成更大的任務(wù)。一段 shell 腳本或者其他程序?qū)?zhí)行它們。發(fā)起調(diào)用的腳本需要獲知被調(diào)用程序是否執(zhí)行成功。 Haskell 自動為異常退出的程序分配一個 “不成功” 的狀態(tài)碼。
不過，你需要對狀態(tài)碼進(jìn)行更細(xì)粒度的控制?？赡苣阈枰獙Σ煌愋偷腻e誤返回不同的代碼。 System.Exit 模塊提供一個途徑可以在程序退出時返回特定的狀態(tài)碼。通過調(diào)用 exitWithExitSuccess 表示程序執(zhí)行成功（POSIX 系統(tǒng)中的 0）?；蛘呖梢哉{(diào)用 exitWith(ExitFailure5) ，表示將在程序退出時向系統(tǒng)返回 5 作為狀態(tài)碼。
日期和時間
從文件時間戳到商業(yè)事務(wù)的很多事情都涉及到日期和時間。 除了從系統(tǒng)獲取日期時間信息之外，Haskell 提供了很多關(guān)于時間日期的操作方法。
ClockTime 和 CalendarTime
在 Haskell 中，日期和時間主要由 System.Time 模塊處理。它定義了兩個類型： ClockTime 和 CalendarTime 。
ClockTime 是傳統(tǒng) POSIX 中時間戳的 Haskell 版本。 ClockTime 表示一個相對于 UTC 1970 年 1 月 1 日 零點的時間。負(fù)值的 ClockTime 表示在其之前的秒數(shù)，正值表示在其之后的秒數(shù)。
ClockTime 便于計算。因為它遵循協(xié)調(diào)世界時（Coordinated Universal Time，UTC），其不必調(diào)整本地時區(qū)、夏令時或其他時間處理中的特例。每天是精確的 (60 60 24) 或 86,400 秒 [44]，這易于計算時間間隔。舉個例子，你可以簡單的記錄某個程序開始執(zhí)行的時間和其結(jié)束的時間，相減即可確定程序的執(zhí)行時間。如果需要的話，還可以除以 3600，這樣就可以按小時顯示。
使用 ClockTime 的典型場景：
- 經(jīng)過了多長時間？
- 相對此刻 14 天前是什么時間？
- 文件的最后修改時間是何時？
- 當(dāng)下的精確時間是何時？
ClockTime 善于處理這些問題，因為它們使用無法混淆的精確時間。但是， ClockTime 不善于處理下列問題：
- 今天是周一嗎？
- 明年 5 月 1 日是周幾？
- 在我的時區(qū)當(dāng)前是什么時間，考慮夏令時。
CalendarTime 按人類的方式存儲時間：年，月，日，小時，分，秒，時區(qū)，夏令時信息。很容易的轉(zhuǎn)換為便于顯示的字符串，或者以上問題的答案。
你可以任意轉(zhuǎn)換 ClockTime 和 CalendarTime 。Haskell 將 ClockTime 可以按本地時區(qū)轉(zhuǎn)換為 CalendarTime ，或者按 CalendarTime 格式表示的 UTC 時間。
使用 ClockTime
ClockTime 在 System.Time 中這樣定義：
data ClockTime = TOD Integer Integer
第一個 Integer 表示從 Unix 紀(jì)元開始經(jīng)過的秒數(shù)。第二個 Integer 表示附加的皮秒數(shù)。因為 Haskell 中的 ClockTime 使用無邊界的 Integer 類型，所以其能夠表示的數(shù)據(jù)范圍僅受計算資源限制。
讓我們看看使用 ClockTime 的一些方法。首先是按系統(tǒng)時鐘獲取當(dāng)前時間的 getClockTime 函數(shù)。
ghci> :module System.Time
ghci> getClockTime
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Mon Aug 18 12:10:38 CDT 2008
如果一秒鐘再次運行 getClockTime ，它將返回一個更新后的時間。這條命令會輸出一個便于觀察的字符串，補全了周相關(guān)的信息。這是由于 ClockTime 的 Show 實例。讓我們從更底層看一下 ClockTime ：
ghci> TOD 1000 0
Wed Dec 31 18:16:40 CST 1969
ghci> getClockTime >>= (\(TOD sec _) -> return sec)
1219079438
這里我們先構(gòu)建一個 ClockTime ，表示 UTC 時間 1970 年 1 月 1 日午夜后 1000 秒這個時間點。在你的時區(qū)這個時間相當(dāng)于 1969 年 12 月 31 日晚。
第二個例子演示如何從 getClockTime 返值中將秒數(shù)取出來。我們可以像這樣操作它：
ghci> getClockTime >>= (\(TOD sec _) -> return (TOD (sec + 86400) 0))
Tue Aug 19 12:10:38 CDT 2008
這將顯精確示你的時區(qū) 24 小時后的時間，因為 24 小時等于 86,400 秒。
使用 CalendarTime
正如其名字暗示的， CalendarTime 按日歷上的方式表示時間。它包括年、月、日等信息。 CalendarTime 和其相關(guān)類型定義如下：
data CalendarTime = CalendarTime
{ctYear :: Int, -- Year (post-Gregorian)
ctMonth :: Month,
ctDay :: Int, -- Day of the month (1 to 31)
ctHour :: Int, -- Hour of the day (0 to 23)
ctMin :: Int, -- Minutes (0 to 59)
ctSec :: Int, -- Seconds (0 to 61, allowing for leap seconds)
ctPicosec :: Integer, -- Picoseconds
ctWDay :: Day, -- Day of the week
ctYDay :: Int, -- Day of the year (0 to 364 or 365)
ctTZName :: String, -- Name of timezone
ctTZ :: Int, -- Variation from UTC in seconds
ctIsDST :: Bool -- True if Daylight Saving Time in effect
}
data Month = January | February | March | April | May | June
| July | August | September | October | November | December
data Day = Sunday | Monday | Tuesday | Wednesday
| Thursday | Friday | Saturday
關(guān)于以上結(jié)構(gòu)有些事情需要強調(diào)：
- ctWDay, ctYDay, ctTZName 是被創(chuàng)建 CalendarTime 的庫函數(shù)生成的，但是并不參與計算。如果你手工創(chuàng)建一個 CalendarTime ，不必向其中填寫準(zhǔn)確的值，除非你的計算依賴于它們。
- 這三個類型都是 Eq, Ord, Read, Show 類型類的成員。另外， Month 和 Day 都被聲明為 Enum 和 Bounded 類型類的成員。更多的信息請參考 “重要的類型類” 這一章節(jié)。
有幾種不同的途徑可以生成 CalendarTime ?？梢韵襁@樣將 ClockTime 轉(zhuǎn)換為 CalendarTime ：
ghci> :module System.Time
ghci> now <- getClockTime
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Mon Aug 18 12:10:35 CDT 2008
ghci> nowCal <- toCalendarTime now
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> let nowUTC = toUTCTime now
ghci> nowCal
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> nowUTC
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 17, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
用 getClockTime 從系統(tǒng)獲得當(dāng)前的 ClockTime 。接下來， toCalendarTime 按本地時間區(qū)將 ClockTime 轉(zhuǎn)換為 CalendarTime 。 toUTCtime 執(zhí)行類似的轉(zhuǎn)換，但其結(jié)果將以 UTC 時區(qū)表示。
注意， toCalendarTime 是一個 IO 函數(shù)，但是 toUTCTime 不是。原因是 toCalendarTime 依賴本地時區(qū)返回不同的結(jié)果，但是針對相同的 ClockTime ， toUTCTime 將始終返回相同的結(jié)果。
很容易改變一個 CalendarTime 的值
ghci> nowCal {ctYear = 1960}
CalendarTime {ctYear = 1960, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> (\(TOD sec _) -> sec) (toClockTime nowCal)
1219079435
ghci> (\(TOD sec _) -> sec) (toClockTime (nowCal {ctYear = 1960}))
-295685365
此處，先將之前的 CalendarTime 年份修改為 1960 。然后用 toClockTime 將其初始值轉(zhuǎn)換為一個 ClockTime ，接著轉(zhuǎn)換新值，以便觀察其差別。注意新值在轉(zhuǎn)換為 ClockTime 后顯示了一個負(fù)的秒數(shù)。這是意料中的， ClockTime 表示的是 UTC 時間 1970 年 1 月 1 日午夜之后的秒數(shù)。
也可以像這樣手工創(chuàng)建 CalendarTime ：
ghci> let newCT = CalendarTime 2010 January 15 12 30 0 0 Sunday 0 "UTC" 0 False
ghci> newCT
CalendarTime {ctYear = 2010, ctMonth = January, ctDay = 15, ctHour = 12, ctMin = 30, ctSec = 0, ctPicosec = 0, ctWDay = Sunday, ctYDay = 0, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> (\(TOD sec _) -> sec) (toClockTime newCT)
1263558600
注意，盡管 2010 年 1 月 15 日并不是一個周日 – 并且也不是一年中的第 0 天 – 系統(tǒng)可以很好的處理這些情況。實際上，如果將其轉(zhuǎn)換為 ClockTime 后再轉(zhuǎn)回 CalendarTime ，你將發(fā)現(xiàn)這些域已經(jīng)被正確的處理了。
ghci> toUTCTime . toClockTime $ newCT
CalendarTime {ctYear = 2010, ctMonth = January, ctDay = 15, ctHour = 12, ctMin = 30, ctSec = 0, ctPicosec = 0, ctWDay = Friday, ctYDay = 14, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ClockTime 的 TimeDiff
以對人類友好的方式難于處理 ClockTime 值之間的差異， System.Time 模塊包括了一個 TimeDiff 類型。 TimeDiff 用于方便的處理這些差異。其定義如下：
data TimeDiff = TimeDiff
{tdYear :: Int,
tdMonth :: Int,
tdDay :: Int,
tdHour :: Int,
tdMin :: Int,
tdSec :: Int,
tdPicosec :: Integer}
diffClockTimes 和 addToClockTime 兩個函數(shù)接收一個 ClockTime 和一個 TimeDiff 并在內(nèi)部將 ClockTime 轉(zhuǎn)換為一個 UTC 時區(qū)的 CalendarTime ，在其上執(zhí)行 TimeDiff ，最后將結(jié)果轉(zhuǎn)換回一個 ClockTime 。
看看它怎樣工作：
ghci> :module System.Time
ghci> let feb5 = toClockTime $ CalendarTime 2008 February 5 0 0 0 0 Sunday 0 "UTC" 0 False
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
ghci> feb5
Mon Feb 4 18:00:00 CST 2008
ghci> addToClockTime (TimeDiff 0 1 0 0 0 0 0) feb5
Tue Mar 4 18:00:00 CST 2008
ghci> toUTCTime $ addToClockTime (TimeDiff 0 1 0 0 0 0 0) feb5
CalendarTime {ctYear = 2008, ctMonth = March, ctDay = 5, ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0, ctWDay = Wednesday, ctYDay = 64, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> let jan30 = toClockTime $ CalendarTime 2009 January 30 0 0 0 0 Sunday 0 "UTC" 0 False
ghci> jan30
Thu Jan 29 18:00:00 CST 2009
ghci> addToClockTime (TimeDiff 0 1 0 0 0 0 0) jan30
Sun Mar 1 18:00:00 CST 2009
ghci> toUTCTime $ addToClockTime (TimeDiff 0 1 0 0 0 0 0) jan30
CalendarTime {ctYear = 2009, ctMonth = March, ctDay = 2, ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0, ctWDay = Monday, ctYDay = 60, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> diffClockTimes jan30 feb5
TimeDiff {tdYear = 0, tdMonth = 0, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 31104000, tdPicosec = 0}
ghci> normalizeTimeDiff $ diffClockTimes jan30 feb5
TimeDiff {tdYear = 0, tdMonth = 12, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 0, tdPicosec = 0}
首先我們生成一個 ClockTime 表示 UTC 時間 2008 年 2 月 5 日。注意，若你的時區(qū)不是 UTC，按你本地時區(qū)的格式，當(dāng)其被顯示的時候可能是 2 月 4 日晚。
其次，我們用 addToClockTime 在其上加一個月。2008 是閏年，但系統(tǒng)可以正確的處理，然后我們得到了一個月后的相同日期。使用 toUTCTime ，我們可以看到以 UTC 時間表示的結(jié)果。
第二個實驗，設(shè)定一個表示 UTC 時間 2009 年 1 月 30 日午夜的時間。2009 年不是閏年，所以我們可能很好奇其加上一個月是什么結(jié)果。因為 2009 年沒有 2 月 29 日和 2 月 30 日，所以我們得到了 3 月 2 日。
最后，我們可以看到 diffClockTimes 怎樣通過兩個 ClockTime 值得到一個 TimeDiff ， 盡管其只包含秒和皮秒。 normalizeTimeDiff 函數(shù)接受一個 TimeDiff 將其重新按照人類的習(xí)慣格式化。
文件修改日期
很多程序需要找出某些文件的最后修改日期。 ls 和圖形化的文件管理器是典型的需要顯示文件最后變更時間的程序。 System.Directory 模塊包含一個跨平臺的 getModificationTime 函數(shù)。其接受一個文件名，返回一個表示文件最后變更日期的 ClockTime 。例如：
ghci> :module System.Directory
ghci> getModificationTime "/etc/passwd"
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Fri Aug 15 08:29:48 CDT 2008
POSIX 平臺不僅維護(hù)變更時間 (被稱為 mtime)， 還有最后讀或?qū)懺L問時間 (atime)以及最后狀態(tài)變更時間 (ctime)。這是 POSIX 平臺獨有的，所以跨平臺的 System.Directory 模塊無法訪問它。取而代之，需要使用 System.Posix.Files 模塊中的函數(shù)。下面有一個例子：
-- file: ch20/posixtime.hs
-- posixtime.hs
import System.Posix.Files
import System.Time
import System.Posix.Types
-- | Given a path, returns (atime, mtime, ctime)
getTimes :: FilePath -> IO (ClockTime, ClockTime, ClockTime)
getTimes fp =
do stat <- getFileStatus fp
return (toct (accessTime stat),
toct (modificationTime stat),
toct (statusChangeTime stat))
-- | Convert an EpochTime to a ClockTime
toct :: EpochTime -> ClockTime
toct et =
TOD (truncate (toRational et)) 0
注意對 getFileStatus 的調(diào)用。 這個調(diào)用直接映射到 C 語言的 stat() 函數(shù)。其返回一個包含了大量不同種類信息的值，包括文件類型、權(quán)限、屬主、組、和我們感性去的三種時間值。 System.Posix.Files 提供了 accessTime 等多個函數(shù)，可以將我們感興趣的時間從 getFileStatus 返回的 FileStatus 類型中提取出來。
accessTime 等函數(shù)返回一個POSIX 平臺特有的類型，稱為 EpochTime ， 可以通過 toct 函數(shù)轉(zhuǎn)換 ClockTime 。 System.Posix.Files 模塊同樣提供了 setFileTimes 函數(shù)，以設(shè)置文件的 atime 和 mtime 。 [45]
延伸的例子: 管道
我們已經(jīng)了解了如何調(diào)用外部程序。有時候需要更多的控制。比如獲得程序的標(biāo)準(zhǔn)輸出、提供輸入，甚至將不同的外部程序串起來調(diào)用。管道有助于實現(xiàn)所有這些需求。管道經(jīng)常用在 shell 腳本中。 在 shell 中設(shè)置一個管道，會調(diào)用多個程序。第一個程序的輸入會做為第二個程序的輸入。其輸出又會作為第三個的輸入，以此類推。最后一個程序通常將輸出打印到終端，或者寫入文件。下面是一個 POSIX shell 的例子，演示如何使用管道：
$ ls /etc | grep 'm.*ap' | tr a-z A-Z
IDMAPD.CONF
MAILCAP
MAILCAP.ORDER
MEDIAPRM
TERMCAP
這條命令運行了三個程序，使用管道在它們之間傳輸數(shù)據(jù)。它以 ls/etc 開始，輸出是 /etc 目錄下全部文件和目錄的列表。 ls 的輸出被作為 grep 的輸入。我們想 grep 輸入一條正則使其只輸出以 ‘m' 開頭并且在某處包含 “ap” 的行。最后，其結(jié)果被傳入 tr 。我們給 tr 設(shè)置一個選項，使其將所有字符轉(zhuǎn)換為大寫。 tr 的輸出沒有特殊的去處，所以直接在屏幕顯示。
這種情況下，程序之間的管道線路由 shell 設(shè)置。我們可以使用 Haskell 中的 POSIX 工具實現(xiàn)同的事情。
在講解如何實現(xiàn)之前，要提醒你一下， System.Posix 模塊提供的是很低階的 Unix 系統(tǒng)接口。無論使用何種編程語言，這些接口都可以相互組合，組合的結(jié)果也可以相互組合。這些低階接口的完整性質(zhì)可以用一整本書來討論，這章中我們只會簡單介紹。
使用管道做重定向
POSIX 定義了一個函數(shù)用于創(chuàng)建管道。這個函數(shù)返回兩個文件描述符（FD），與 Haskell 中的句柄概念類似。一個 FD 用于讀端，另一個用于寫端。任何從寫端寫入的東西，都可以從讀端讀取。這些數(shù)據(jù)就是“通過管道推送”的。在 Haskell 中，你可以通過 createPipe 使用這個接口。
在外部程序之間傳遞數(shù)據(jù)之前，要做的第一步是建立一個管道。同時還要將一個程序的輸出重定向到管道，并將管道做為另一個程序的輸入。 Haskell 的 dupTo 函數(shù)就是做這個的。其接收一個 FD 并將其拷貝為另一個 FD 號。 POSIX 的標(biāo)準(zhǔn)輸入、標(biāo)準(zhǔn)輸出和標(biāo)準(zhǔn)錯誤的 FD 分別被預(yù)定義為 0, 1, 2 。將管道的某一端設(shè)置為這些 FD 號，我們就可以有效的重定向程序的輸入和輸出。
不過還有問題需要解決。我們不能簡單的只是在某個調(diào)用比如 rawSystem 之前使用 dupTo ，因為這回混淆我們的 Haskell 主程序的輸入和輸出。此外， rawSystem 會一直阻塞直到被調(diào)用的程序執(zhí)行完畢，這讓我們無法啟動并行執(zhí)行的進(jìn)程。 為了解決這個問題，可以使用 forkProcess 。這是一個很特殊的函數(shù)。它實際上生成了一份當(dāng)前進(jìn)程的拷貝，并使這兩份進(jìn)程同時運行。 Haskell 的 forkProcess 函數(shù)接收一個函數(shù)，使其在新進(jìn)程（稱為子進(jìn)程）中運行。我們讓這個函數(shù)調(diào)用 dupTo 。之后，其調(diào)用 executeFile 調(diào)用真正希望執(zhí)行的命令。這同樣也是一個特殊的函數(shù)：如果一切順利，他將不會返回。這是因為 executeFile 使用一個不同的程序替換了當(dāng)前執(zhí)行的進(jìn)程。最后，初始的 Haskell 進(jìn)程調(diào)用 getProcessStatus 以等待子進(jìn)程結(jié)束，并獲得其狀態(tài)碼。
在 POSIX 系統(tǒng)中，無論何時你執(zhí)行一條命令，不關(guān)是在命令上上敲 ls 還是在 Haskell 中使用 rawSystem ，其內(nèi)部機理都是調(diào)用 forkProcess , executeFile , 和 getProcessStatusa (或是它們對應(yīng)的 C 函數(shù))。為了使用管道，我們復(fù)制了系統(tǒng)啟動程序的進(jìn)程，并且加入了一些調(diào)用和重定向管道的步驟。
還有另外一些輔助步驟需要注意。當(dāng)調(diào)用 forkProcess 時，“幾乎”和程序有關(guān)的一切都被復(fù)制 [46] 。包括所有已經(jīng)打開的文件描述符（句柄）。程序通過檢查管道是否傳來文件結(jié)束符判斷數(shù)據(jù)接收是否結(jié)束。寫端進(jìn)程關(guān)閉管道時，讀端程序?qū)⑹盏轿募Y(jié)束符。然而，如果同一個寫端文件描述符在多個進(jìn)程中同時存在，則文件結(jié)束符要在所有進(jìn)程中都被關(guān)閉才會發(fā)送文件結(jié)束符。因此，我們必須在子進(jìn)程中追蹤打開了哪些文件描述符，以便關(guān)閉它們。同樣，也必須盡早在主進(jìn)程中關(guān)閉子進(jìn)程的寫管道。
下面是一個用 Haskell 編寫的管道系統(tǒng)的初始實現(xiàn)：
-- file: ch20/RunProcessSimple.hs
{-# OPTIONS_GHC -XDatatypeContexts #-}
{-# OPTIONS_GHC -XTypeSynonymInstances #-}
{-# OPTIONS_GHC -XFlexibleInstances #-}
module RunProcessSimple where
--import System.Process
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO
import System.Exit
import Text.Regex.Posix
import System.Posix.Process
import System.Posix.IO
import System.Posix.Types
import Control.Exception
{- | The type for running external commands. The first part
of the tuple is the program name. The list represents the
command-line parameters to pass to the command. -}
type SysCommand = (String, [String])
{- | The result of running any command -}
data CommandResult = CommandResult {
cmdOutput :: IO String, -- ^ IO action that yields the output
getExitStatus :: IO ProcessStatus -- ^ IO action that yields exit result
}
{- | The type for handling global lists of FDs to always close in the clients
-}
type CloseFDs = MVar [Fd]
{- | Class representing anything that is a runnable command -}
class CommandLike a where
{- | Given the command and a String representing input,
invokes the command. Returns a String
representing the output of the command. -}
invoke :: a -> CloseFDs -> String -> IO CommandResult
-- Support for running system commands
instance CommandLike SysCommand where
invoke (cmd, args) closefds input =
do -- Create two pipes: one to handle stdin and the other
-- to handle stdout. We do not redirect stderr in this program.
(stdinread, stdinwrite) <- createPipe
(stdoutread, stdoutwrite) <- createPipe
-- We add the parent FDs to this list because we always need
-- to close them in the clients.
addCloseFDs closefds [stdinwrite, stdoutread]
-- Now, grab the closed FDs list and fork the child.
childPID <- withMVar closefds (\fds ->
forkProcess (child fds stdinread stdoutwrite))
-- Now, on the parent, close the client-side FDs.
closeFd stdinread
closeFd stdoutwrite
-- Write the input to the command.
stdinhdl <- fdToHandle stdinwrite
forkIO $ do hPutStr stdinhdl input
hClose stdinhdl
-- Prepare to receive output from the command
stdouthdl <- fdToHandle stdoutread
-- Set up the function to call when ready to wait for the
-- child to exit.
let waitfunc =
do status <- getProcessStatus True False childPID
case status of
Nothing -> fail $ "Error: Nothing from getProcessStatus"
Just ps -> do removeCloseFDs closefds
[stdinwrite, stdoutread]
return ps
return $ CommandResult {cmdOutput = hGetContents stdouthdl,
getExitStatus = waitfunc}
-- Define what happens in the child process
where child closefds stdinread stdoutwrite =
do -- Copy our pipes over the regular stdin/stdout FDs
dupTo stdinread stdInput
dupTo stdoutwrite stdOutput
-- Now close the original pipe FDs
closeFd stdinread
closeFd stdoutwrite
-- Close all the open FDs we inherited from the parent
mapM_ (\fd -> catch (closeFd fd) (\(SomeException e) -> return ())) closefds
-- Start the program
executeFile cmd True args Nothing
-- Add FDs to the list of FDs that must be closed post-fork in a child
addCloseFDs :: CloseFDs -> [Fd] -> IO ()
addCloseFDs closefds newfds =
modifyMVar_ closefds (\oldfds -> return $ oldfds ++ newfds)
-- Remove FDs from the list
removeCloseFDs :: CloseFDs -> [Fd] -> IO ()
removeCloseFDs closefds removethem =
modifyMVar_ closefds (\fdlist -> return $ procfdlist fdlist removethem)
where
procfdlist fdlist [] = fdlist
procfdlist fdlist (x:xs) = procfdlist (removefd fdlist x) xs
-- We want to remove only the first occurance ot any given fd
removefd [] _ = []
removefd (x:xs) fd
| fd == x = xs
| otherwise = x : removefd xs fd
{- | Type representing a pipe. A 'PipeCommand' consists of a source
and destination part, both of which must be instances of
'CommandLike'. -}
data (CommandLike src, CommandLike dest) =>
PipeCommand src dest = PipeCommand src dest
{- | A convenient function for creating a 'PipeCommand'. -}
(-|-) :: (CommandLike a, CommandLike b) => a -> b -> PipeCommand a b
(-|-) = PipeCommand
{- | Make 'PipeCommand' runnable as a command -}
instance (CommandLike a, CommandLike b) =>
CommandLike (PipeCommand a b) where
invoke (PipeCommand src dest) closefds input =
do res1 <- invoke src closefds input
output1 <- cmdOutput res1
res2 <- invoke dest closefds output1
return $ CommandResult (cmdOutput res2) (getEC res1 res2)
{- | Given two 'CommandResult' items, evaluate the exit codes for
both and then return a "combined" exit code. This will be ExitSuccess
if both exited successfully. Otherwise, it will reflect the first
error encountered. -}
getEC :: CommandResult -> CommandResult -> IO ProcessStatus
getEC src dest =
do sec <- getExitStatus src
dec <- getExitStatus dest
case sec of
Exited ExitSuccess -> return dec
x -> return x
{- | Execute a 'CommandLike'. -}
runIO :: CommandLike a => a -> IO ()
runIO cmd =
do -- Initialize our closefds list
closefds <- newMVar []
-- Invoke the command
res <- invoke cmd closefds []
-- Process its output
output <- cmdOutput res
putStr output
-- Wait for termination and get exit status
ec <- getExitStatus res
case ec of
Exited ExitSuccess -> return ()
x -> fail $ "Exited: " ++ show x
在研究這個函數(shù)的運作原理之前，讓我們先來在 ghci 里面嘗試運行它一下：
ghci> runIO $ ("pwd", []::[String])
/Users/Blade/sandbox
ghci> runIO $ ("ls", ["/usr"])
NX
X11
X11R6
bin
include
lib
libexec
local
sbin
share
standalone
ghci> runIO $ ("ls", ["/usr"]) -|- ("grep", ["^l"])
lib
libexec
local
ghci> runIO $ ("ls", ["/etc"]) -|- ("grep", ["m.*ap"]) -|- ("tr", ["a-z", "A-Z"])
COM.APPLE.SCREENSHARING.AGENT.LAUNCHD
我們從一個簡單的命令 pwd 開始，它會打印當(dāng)前工作目錄。我們將 [] 做為參數(shù)列表，因為 pwd 不需要任何參數(shù)。由于使用了類型類， Haskell 無法自動推導(dǎo)出 [] 的類型，所以我們說明其類型為字符串組成的列表。
下面是一個更復(fù)雜些的例子。我們執(zhí)行了 ls ，將其輸出傳入 grep 。最后我們通過管道，調(diào)用了一個與本節(jié)開始處 shell 內(nèi)置管道的例子中相同的命令。不像 shell 中那樣舒服，但是相對于 shell 我們的程序始終相對簡單。
讓我們讀一下程序。起始處的 OPTIONS_GHC 語句，作用與 ghc 或 ghci 開始時傳入 -fglasgow-exts 參數(shù)相同。我們使用了一個 GHC 擴展，以允許使用 (String,[String]) 類型作為一個類型類的實例 [47] 。將此類聲明加入源碼文件，就不用在每次調(diào)用這個模塊的時候都要記得手工打開編譯器開關(guān)。
在載入了所需模塊之后，定義了一些類型。首先，定義 typeSysCommand=(String,[String]) 作為一個別名。這是系統(tǒng)將接收并執(zhí)行的命令的類型。例子中的每條領(lǐng)命都要用到這個類型的數(shù)據(jù)。 CommandResult 命令用于表示給定命令的執(zhí)行結(jié)果， CloseFDs 用于表示必須在新的子進(jìn)程中關(guān)閉的文件描述符列表。
接著，定義一個類稱為 CommandLike 。這個類用來跑 “東西” ，這個“東西” 可以是獨立的程序，可以是兩個程序之間的管道，未來也可以跑純 Haskell 函數(shù)。任何一個類型想為這個類的成員，只需實現(xiàn)一個函數(shù) – invoke 。這將允許以 runIO 啟動一個獨立命令或者一個管道。這在定義管道時也很有用，因為我們可以擁有某個管道的讀寫兩端的完整調(diào)用棧。
我們的管道基礎(chǔ)設(shè)施將使用字符串在進(jìn)程間傳遞數(shù)據(jù)。我們將通過 hGetContents 獲得 Haskell 在延遲讀取方面的優(yōu)勢，并使用 forkIO 在后臺寫入。這種設(shè)計工作得不錯，盡管傳輸速度不像將兩個進(jìn)程的管道讀寫端直接連接起來那樣快 [48] 。但這讓實現(xiàn)很簡單。我們僅需要小心，不要做任何會讓整個字符串被緩沖的操作，把接下來的工作完全交給 Haskell 的延遲特性。
接下來，為 SysCommand 定義一個 CommandLike 實例。我們創(chuàng)建兩個管道：一個用來作為新進(jìn)程的標(biāo)準(zhǔn)輸入，另一個用于其標(biāo)準(zhǔn)輸出。將產(chǎn)生兩個讀端兩個寫端，四個文件描述符。我們將要在子進(jìn)程中關(guān)閉的文件描述符加入列表。這包括子進(jìn)程標(biāo)準(zhǔn)輸入的寫端，和子進(jìn)程標(biāo)準(zhǔn)輸出的讀端。接著，我們 fork 出子進(jìn)程。然后可以在父進(jìn)程中關(guān)閉相關(guān)的子進(jìn)程文件描述符。 fork 之前不能這樣做，因為那時子進(jìn)程還不可用。獲取 stdinwrite 的句柄，并通過 forkIO 啟動一個現(xiàn)成向其寫入數(shù)據(jù)。接著定義 waitfunc , 其中定義了調(diào)用這在準(zhǔn)備好等待子進(jìn)程結(jié)束時要執(zhí)行的動作。同時，子進(jìn)程使用 dupTo ，關(guān)閉其不需要的文件描述符。并執(zhí)行命令。
然后定義一些工具函數(shù)用來管理文件描述符。此后，定義一些工具用于建立管道。首先，定義一個新類型 PipeCommand ，其有源和目的兩個屬性。源和目的都必須是 CommandLike 的成員。為了方便，我們還定義了 -|- 操作符。然后使 PipeCommand 成為 CommandLike 的實例。它調(diào)用第一個命令并獲得輸出，將其傳入第二個命令。之后返回第二個命令的輸出，并調(diào)用 getExitStatus 函數(shù)等待命令執(zhí)行結(jié)束并檢查整組命令執(zhí)行之后的狀態(tài)碼。
最后以定義 runIO 結(jié)束。這個函數(shù)建立了需要在子進(jìn)程中關(guān)閉的 FDS 列表，執(zhí)行程序，顯示輸出，并檢查其退出狀態(tài)。
更好的管道
上個例子中解決了一個類似 shell 的管道系統(tǒng)的基本需求。但是為它加上下面這些特點之后就更好了：
- 支持更多的 shell 語法。
- 使管道同時支持外部程序和正規(guī) Haskell 函數(shù)，并使二者可以自由的混合使用。
- 以易于 Haskell 程序利用的方式返回標(biāo)準(zhǔn)輸出和退出狀態(tài)碼。
幸運的是，支持這些功能的代碼片段已經(jīng)差不多就位了。只需要為 CommandLike 多加入幾個實例，以及一些類似 runIO 的函數(shù)。下面是修訂后實現(xiàn)了以上功能的例子代碼：
-- file: ch20/RunProcess.hs
{-# OPTIONS_GHC -XDatatypeContexts #-}
{-# OPTIONS_GHC -XTypeSynonymInstances #-}
{-# OPTIONS_GHC -XFlexibleInstances #-}
module RunProcess where
import System.Process
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception
import System.Posix.Directory
import System.Directory(setCurrentDirectory)
import System.IO
import System.Exit
import Text.Regex
import System.Posix.Process
import System.Posix.IO
import System.Posix.Types
import Data.List
import System.Posix.Env(getEnv)
{- | The type for running external commands. The first part
of the tuple is the program name. The list represents the
command-line parameters to pass to the command. -}
type SysCommand = (String, [String])
{- | The result of running any command -}
data CommandResult = CommandResult {
cmdOutput :: IO String, -- ^ IO action that yields the output
getExitStatus :: IO ProcessStatus -- ^ IO action that yields exit result
}
{- | The type for handling global lists of FDs to always close in the clients
-}
type CloseFDs = MVar [Fd]
{- | Class representing anything that is a runnable command -}
class CommandLike a where
{- | Given the command and a String representing input,
invokes the command. Returns a String
representing the output of the command. -}
invoke :: a -> CloseFDs -> String -> IO CommandResult
-- Support for running system commands
instance CommandLike SysCommand where
invoke (cmd, args) closefds input =
do -- Create two pipes: one to handle stdin and the other
-- to handle stdout. We do not redirect stderr in this program.
(stdinread, stdinwrite) <- createPipe
(stdoutread, stdoutwrite) <- createPipe
-- We add the parent FDs to this list because we always need
-- to close them in the clients.
addCloseFDs closefds [stdinwrite, stdoutread]
-- Now, grab the closed FDs list and fork the child.
childPID <- withMVar closefds (\fds ->
forkProcess (child fds stdinread stdoutwrite))
-- Now, on the parent, close the client-side FDs.
closeFd stdinread
closeFd stdoutwrite
-- Write the input to the command.
stdinhdl <- fdToHandle stdinwrite
forkIO $ do hPutStr stdinhdl input
hClose stdinhdl
-- Prepare to receive output from the command
stdouthdl <- fdToHandle stdoutread
-- Set up the function to call when ready to wait for the
-- child to exit.
let waitfunc =
do status <- getProcessStatus True False childPID
case status of
Nothing -> fail $ "Error: Nothing from getProcessStatus"
Just ps -> do removeCloseFDs closefds
[stdinwrite, stdoutread]
return ps
return $ CommandResult {cmdOutput = hGetContents stdouthdl,
getExitStatus = waitfunc}
-- Define what happens in the child process
where child closefds stdinread stdoutwrite =
do -- Copy our pipes over the regular stdin/stdout FDs
dupTo stdinread stdInput
dupTo stdoutwrite stdOutput
-- Now close the original pipe FDs
closeFd stdinread
closeFd stdoutwrite
-- Close all the open FDs we inherited from the parent
mapM_ (\fd -> catch (closeFd fd) (\(SomeException e) -> return ())) closefds
-- Start the program
executeFile cmd True args Nothing
{- | An instance of 'CommandLike' for an external command. The String is
passed to a shell for evaluation and invocation. -}
instance CommandLike String where
invoke cmd closefds input =
do -- Use the shell given by the environment variable SHELL,
-- if any. Otherwise, use /bin/sh
esh <- getEnv "SHELL"
let sh = case esh of
Nothing -> "/bin/sh"
Just x -> x
invoke (sh, ["-c", cmd]) closefds input
-- Add FDs to the list of FDs that must be closed post-fork in a child
addCloseFDs :: CloseFDs -> [Fd] -> IO ()
addCloseFDs closefds newfds =
modifyMVar_ closefds (\oldfds -> return $ oldfds ++ newfds)
-- Remove FDs from the list
removeCloseFDs :: CloseFDs -> [Fd] -> IO ()
removeCloseFDs closefds removethem =
modifyMVar_ closefds (\fdlist -> return $ procfdlist fdlist removethem)
where
procfdlist fdlist [] = fdlist
procfdlist fdlist (x:xs) = procfdlist (removefd fdlist x) xs
-- We want to remove only the first occurance ot any given fd
removefd [] _ = []
removefd (x:xs) fd
| fd == x = xs
| otherwise = x : removefd xs fd
-- Support for running Haskell commands
instance CommandLike (String -> IO String) where
invoke func _ input =
return $ CommandResult (func input) (return (Exited ExitSuccess))
-- Support pure Haskell functions by wrapping them in IO
instance CommandLike (String -> String) where
invoke func = invoke iofunc
where iofunc :: String -> IO String
iofunc = return . func
-- It's also useful to operate on lines. Define support for line-based
-- functions both within and without the IO monad.
instance CommandLike ([String] -> IO [String]) where
invoke func _ input =
return $ CommandResult linedfunc (return (Exited ExitSuccess))
where linedfunc = func (lines input) >>= (return . unlines)
instance CommandLike ([String] -> [String]) where
invoke func = invoke (unlines . func . lines)
{- | Type representing a pipe. A 'PipeCommand' consists of a source
and destination part, both of which must be instances of
'CommandLike'. -}
data (CommandLike src, CommandLike dest) =>
PipeCommand src dest = PipeCommand src dest
{- | A convenient function for creating a 'PipeCommand'. -}
(-|-) :: (CommandLike a, CommandLike b) => a -> b -> PipeCommand a b
(-|-) = PipeCommand
{- | Make 'PipeCommand' runnable as a command -}
instance (CommandLike a, CommandLike b) =>
CommandLike (PipeCommand a b) where
invoke (PipeCommand src dest) closefds input =
do res1 <- invoke src closefds input
output1 <- cmdOutput res1
res2 <- invoke dest closefds output1
return $ CommandResult (cmdOutput res2) (getEC res1 res2)
{- | Given two 'CommandResult' items, evaluate the exit codes for
both and then return a "combined" exit code. This will be ExitSuccess
if both exited successfully. Otherwise, it will reflect the first
error encountered. -}
getEC :: CommandResult -> CommandResult -> IO ProcessStatus
getEC src dest =
do sec
掃描二維碼
下載編程獅App
編程獅公眾號
更多建議：