%
\section[BSD]{Misc BSD bindings}
-The @BSD@ module defines Haskell bindings to network programming
-functionality that is only provided by BSD-style APIs.
+The @BSD@ module defines Haskell bindings to functionality
+provided by BSD Unix derivatives. Currently this covers
+network programming functionality and symbolic links.
+(OK, so the latter is pretty much supported by most *nixes
+today, but it was BSD that introduced them.)
\begin{code}
-{-# OPTIONS -#include "cbits/ghcSockets.h" #-}
+{-# OPTIONS -#include "cbits/ghcSockets.h" -#include "stgio.h" #-}
#include "config.h"
getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry
getServicePortNumber, -- :: ServiceName -> IO PortNumber
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
getServiceEntry, -- :: IO ServiceEntry
setServiceEntry, -- :: Bool -> IO ()
endServiceEntry, -- :: IO ()
getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
setProtocolEntry, -- :: Bool -> IO ()
getProtocolEntry, -- :: IO ProtocolEntry
endProtocolEntry, -- :: IO ()
getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
hostAddress, -- :: HostEntry -> HostAddress
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
setHostEntry, -- :: Bool -> IO ()
getHostEntry, -- :: IO HostEntry
endHostEntry, -- :: IO ()
NetworkName,
NetworkAddr,
- NetworkEntry(..),
-#ifndef cygwin32_TARGET_OS
- getNetworkByName, -- :: NetworkName -> IO NetworkEntry
- getNetworkByAddr, -- :: NetworkAddr -> Family -> IO NetworkEntry
- setNetworkEntry, -- :: Bool -> IO ()
- getNetworkEntry, -- :: IO NetworkEntry
- endNetworkEntry, -- :: IO ()
- getNetworkEntries -- :: Bool -> IO [NetworkEntry]
+ NetworkEntry(..)
+#ifndef _WIN32
+ , getNetworkByName -- :: NetworkName -> IO NetworkEntry
+ , getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry
+ , setNetworkEntry -- :: Bool -> IO ()
+ , getNetworkEntry -- :: IO NetworkEntry
+ , endNetworkEntry -- :: IO ()
+ , getNetworkEntries -- :: Bool -> IO [NetworkEntry]
#endif
+
+#ifdef HAVE_SYMLINK
+ , symlink -- :: String -> String -> IO ()
+#endif
+#ifdef HAVE_READLINK
+ , readlink -- :: String -> IO String
+#endif
+
) where
import Foreign
import Addr
-import PackedString ( cByteArrayToPS, unpackPS, unpackCStringIO )
-
-import PosixUtil ( unvectorize )
+import CString ( unpackCStringIO, unpackCStringBA, unvectorize, unpackNBytesBA )
import SocketPrim
\end{code}
getServiceByName name proto = do
ptr <- _ccall_ getservbyname name proto
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such service entry")
+ then ioError (IOError Nothing NoSuchThing "getServiceByName" "no such service entry")
else unpackServiceEntry ptr
getServiceByPort :: PortNumber
getServiceByPort (PNum port) proto = do
ptr <- _ccall_ getservbyport port proto
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such service entry")
+ then ioError (IOError Nothing NoSuchThing "getServiceByPort" "no such service entry")
else unpackServiceEntry ptr
getServicePortNumber :: ServiceName -> IO PortNumber
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
return port
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
getServiceEntry :: IO ServiceEntry
getServiceEntry = do
ptr <- _ccall_ getservent
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such service entry")
+ then ioError (IOError Nothing NoSuchThing "getServiceEntry" "no such service entry")
else unpackServiceEntry ptr
setServiceEntry :: Bool -> IO ()
setServiceEntry flg = _ccall_ setservent stayOpen
- where stayOpen = if flg then 1 else 0
+ where stayOpen = (if flg then 1 else 0) :: Int
endServiceEntry :: IO ()
endServiceEntry = _ccall_ endservent
getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
getProtocolNumber :: ProtocolName -> IO ProtocolNumber
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
endProtocolEntry :: IO ()
getProtocolByName name = do
ptr <- _ccall_ getprotobyname name
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such protocol entry")
+ then ioError (IOError Nothing NoSuchThing "getProtocolByName" "no such protocol entry")
else unpackProtocolEntry ptr
--getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
getProtocolByNumber num = do
ptr <- _ccall_ getprotobynumber num
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such protocol entry")
+ then ioError (IOError Nothing NoSuchThing "getProtocolByNumber" "no such protocol entry")
else unpackProtocolEntry ptr
--getProtocolNumber :: ProtocolName -> IO ProtocolNumber
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
--getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
getProtocolEntry = do
ptr <- _ccall_ getprotoent
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such protocol entry")
+ then ioError (IOError Nothing NoSuchThing "getProtocolEntry" "no such protocol entry")
else unpackProtocolEntry ptr
--setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
setProtocolEntry flg = _ccall_ setprotoent v
- where v = if flg then 1 else 0
+ where v = (if flg then 1 else 0) :: Int
--endProtocolEntry :: IO ()
endProtocolEntry = _ccall_ endprotoent
getHostByName name = do
ptr <- _ccall_ gethostbyname name
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such host entry")
+ then ioError (IOError Nothing NoSuchThing "getHostByName" "no such host entry")
else unpackHostEntry ptr
getHostByAddr :: Family -> HostAddress -> IO HostEntry
addr
(packFamily family)
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such host entry")
+ then ioError (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
else unpackHostEntry ptr
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
getHostEntry :: IO HostEntry
getHostEntry = do
ptr <- _ccall_ gethostent
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "unable to retrieve host entry")
+ then ioError (IOError Nothing NoSuchThing "getHostEntry" "unable to retrieve host entry")
else unpackHostEntry ptr
setHostEntry :: Bool -> IO ()
setHostEntry flg = _ccall_ sethostent v
- where v = if flg then 1 else 0
+ where v = (if flg then 1 else 0) :: Int
endHostEntry :: IO ()
endHostEntry = _ccall_ endhostent
networkFamily :: Family, -- type
networkAddress :: NetworkAddr
}
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
getNetworkByName :: NetworkName -> IO NetworkEntry
getNetworkByName name = do
ptr <- _ccall_ getnetbyname name
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such network entry")
+ then ioError (IOError Nothing NoSuchThing "getNetworkByName" "no such network entry")
else unpackNetworkEntry ptr
getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry
getNetworkByAddr addr family = do
ptr <- _ccall_ getnetbyaddr addr (packFamily family)
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no such network entry")
+ then ioError (IOError Nothing NoSuchThing "getNetworkByAddr" "no such network entry")
else unpackNetworkEntry ptr
getNetworkEntry :: IO NetworkEntry
getNetworkEntry = do
ptr <- _ccall_ getnetent
if ptr == nullAddr
- then fail (IOError Nothing NoSuchThing "no more network entries")
+ then ioError (IOError Nothing NoSuchThing "getNetworkEntry" "no more network entries")
else unpackNetworkEntry ptr
setNetworkEntry :: Bool -> IO ()
setNetworkEntry flg = _ccall_ setnetent v
- where v = if flg then 1 else 0
+ where v = (if flg then 1 else 0) :: Int
endNetworkEntry :: IO ()
endNetworkEntry = _ccall_ endnetent
getHostName = do
ptr <- stToIO (newCharArray (0,256))
rc <- _casm_ ``%r=gethostname(%0, 256);'' ptr
- ba <- stToIO (unsafeFreezeByteArray ptr)
- if rc == -1
- then fail (userError "getHostName: unable to determine host name")
- else return (unpackPS (cByteArrayToPS ba))
+ if rc == ((-1)::Int)
+ then ioError (userError "getHostName: unable to determine host name")
+ else do
+ ba <- stToIO (unsafeFreezeByteArray ptr)
+ return (unpackCStringBA ba)
\end{code}
Helper function used by the exported functions that provides a
\begin{code}
unpackServiceEntry :: Addr -> PrimIO ServiceEntry
unpackServiceEntry ptr = do
- str <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
- name <- unpackCStringIO str
+ pname <- _casm_ ``%r = ((struct servent*)%0)->s_name;'' ptr
+ name <- unpackCStringIO pname
alias <- _casm_ ``%r = ((struct servent*)%0)->s_aliases;'' ptr
aliases <- unvectorize alias 0
port <- _casm_ ``%r = (int)(((struct servent*)%0)->s_port);'' ptr
xs <- unvectorizeHostAddrs ptr (n+1)
return (x : xs)
+
+\end{code}
+
+%***************************************************************************
+%* *
+\subsection[BSD-symlink]{Symbolic links}
+%* *
+%***************************************************************************
+
+
+\begin{code}
+#ifdef HAVE_SYMLINK
+symlink :: String -> String -> IO ()
+symlink actual_path sym_path = do
+ rc <- _ccall_ symlink actual_path sym_path
+ if rc == (0::Int) then
+ return ()
+ else do
+ _ccall_ convertErrno
+ cstr <- _ccall_ getErrStr__
+ estr <- unpackCStringIO cstr
+ ioError (userError ("BSD.symlink: " ++ estr))
+#endif
+
+#ifdef HAVE_READLINK
+readlink :: String -> IO String
+readlink sym = do
+ mbuf <- stToIO (newCharArray (0, path_max))
+ buf <- stToIO (unsafeFreezeByteArray mbuf)
+ rc <- _ccall_ readlink sym buf (path_max + 1)
+ if rc /= -1 then
+ return (unpackNBytesBA buf rc)
+ else do
+ _ccall_ convertErrno
+ cstr <- _ccall_ getErrStr__
+ estr <- unpackCStringIO cstr
+ ioError (userError ("BSD.readlink: " ++ estr))
+ where
+ path_max = (``PATH_MAX''::Int)
+#endif
+
\end{code}
projects / ghc-hetmet.git / blobdiff