diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,502 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/System/Linux/Blkid.hs b/System/Linux/Blkid.hs new file mode 100644 --- /dev/null +++ b/System/Linux/Blkid.hs @@ -0,0 +1,12 @@ +-- | Bindings to the Linux @libblkid@ library. +module System.Linux.Blkid + ( module System.Linux.Blkid.Cache + , module System.Linux.Blkid.Evaluate + , module System.Linux.Blkid.Probe + , module System.Linux.Blkid.Utils + ) where + +import System.Linux.Blkid.Cache +import System.Linux.Blkid.Evaluate +import System.Linux.Blkid.Probe +import System.Linux.Blkid.Utils diff --git a/System/Linux/Blkid/Cache.hsc b/System/Linux/Blkid/Cache.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/Blkid/Cache.hsc @@ -0,0 +1,367 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Basic routines to work with @libblkid@ cache. +module System.Linux.Blkid.Cache + ( CacheT + , withCache + , gcCache + , probeAll + , probeAllRemovable + , probeAllNew + , verify + , evaluateTagUsingCache + , evaluateSpecUsingCache + , Device + , getDevices + , getDevicesWithTag + , deviceGetTags + , deviceHasTag + , findDeviceWithTag + , DevFlags(..) + , getDevice + , getDevname + , getTagValue + ) where + +import Control.Exception (bracket) +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.State +import Foreign +import Foreign.C +import System.Linux.Blkid.Evaluate (Tag(..)) + +#include + +foreign import ccall "stdlib.h free" + c_free :: Ptr a -> IO () + +type BlkidCache = Ptr BlkidStructCache + +data BlkidStructCache + +-- | An operation using the @blkid.tab@ cache file, and returning a +-- value of type @a@. The computation is not performed until +-- @'withCache'@ is called. +newtype CacheT m a = CacheT {runCacheT :: StateT BlkidCache m a} + +instance MonadTrans CacheT where + lift = CacheT . lift + +instance Functor f => Functor (CacheT f) where + fmap f = CacheT . (fmap f) . runCacheT + +instance Monad m => Monad (CacheT m) where + return = CacheT . return + (CacheT m) >>= f = CacheT (m >>= runCacheT . f) + fail = CacheT . fail + + +instance MonadIO m => MonadIO (CacheT m) where + liftIO = CacheT . liftIO + +-- | Run a @'CacheT'@ operation using the given cache file, or the +-- default (@\/run\/blkid\/blkid.tab@) if @'Nothing'@ is passed. After +-- completing the computation, the new cache is written to the file if +-- the user has sufficent privileges. +withCache :: MonadIO m => Maybe FilePath -> CacheT m a -> m a +withCache mpath (CacheT (StateT f)) = + do c <- liftIO $ + maybeWith withCString mpath $ \cstr -> + alloca $ \p -> + do e <- get_cache p cstr + if e < 0 + then fail ("blkid_get_cache returned " ++ show e) + else peek p + (a,c') <- f c + liftIO $ put_cache c' + return a + +--getDevices :: MonadIO m => CacheT m [Device] + +--getDevice :: MonadIO m => String -> DevFlags -> CacheT m (Maybe Device) + +type BlkidDev = Ptr Device + +-- | A device as represented in the @blkid.tab@ cache file. +data Device = Device (ForeignPtr Device) String + +withDevice :: Device -> (BlkidDev -> IO a) -> IO a +withDevice (Device p _) = withForeignPtr p + +toDevice :: BlkidDev -> IO Device +toDevice p = do fp <- newForeignPtr_ p + name <- dev_devname p >>= peekCString + return (Device fp name) + +instance Show Device where + show (Device _ name) = name + +-- | Removes garbage (non-existing devices) from the cache. +gcCache :: MonadIO m => CacheT m () +gcCache = CacheT $ StateT $ \c -> do liftIO $ gc_cache c + return ((),c) + +-- | Probes all block devices. +probeAll :: MonadIO m => CacheT m () +probeAll = + CacheT $ StateT $ \c -> + do liftIO $ throwIfNeg_ (\e -> "blkid_probe_all returned " ++ show e) + (probe_all c) + return ((),c) + +-- | The libblkid probing is based on devices from +-- @\/proc\/partitions@ by default. This file usually does not contain +-- removable devices (e.g. CDROMs) and this kind of devices are +-- invisible for libblkid. +-- +-- This function adds removable block devices to cache (probing is +-- based on information from the @\/sys@ directory). Don't forget that +-- removable devices (floppies, CDROMs, ...) could be pretty +-- slow. It's very bad idea to call this function by default. +-- +-- Note that devices which were detected by this function won't be +-- written to @blkid.tab@ cache file. +probeAllRemovable :: MonadIO m => CacheT m () +probeAllRemovable = + CacheT $ StateT $ \c -> + do liftIO $ throwIfNeg_ (\e -> "blkid_probe_all_removable returned " ++ + show e) (probe_all_removable c) + return ((),c) + +-- | Probes all new block devices. +probeAllNew :: MonadIO m => CacheT m () +probeAllNew = + CacheT $ StateT $ \c -> + do liftIO $ throwIfNeg_ (\e -> "blkid_probe_all_new returned " ++ + show e) (probe_all_new c) + return ((),c) + +-- | Verify that the data in @'Device'@ is consistent with what is on +-- the actual block device (using the devname field only). Normally +-- this will be called when finding items in the cache, but for long +-- running processes is also desirable to revalidate an item before +-- use. +verify :: MonadIO m => Device -> CacheT m Device +verify dev = + CacheT $ StateT $ \c -> + do dev' <- liftIO $ withDevice dev $ \d -> blkid_verify c d >>= toDevice + return (dev',c) + +-- | Get the list of tags and values for the given @'Device'@. +deviceGetTags :: MonadIO m => Device -> m [(String, String)] +deviceGetTags dev = + liftIO $ withDevice dev $ \d -> bracket (begin d) tag_iterate_end getTag + where begin ptr = do it <- tag_iterate_begin ptr + if it == nullPtr + then fail "blkid_tag_iterate_begin returned NULL" + else return it + getTag iter = alloca $ \t -> + alloca $ \v -> + do e <- tag_next iter t v + if e < 0 + then return [] + else do typ <- peek t >>= peekCString + val <- peek v >>= peekCString + xs <- getTag iter + return ((typ,val):xs) + +-- | Check if @'Device'@ has the give tag and value. +deviceHasTag :: MonadIO m => Device -> String -> String -> m Bool +deviceHasTag dev typ val = + liftIO $ withDevice dev $ \d -> + withCString typ $ \t -> + withCString val $ \v -> + dev_has_tag d t v >>= return . toBool + +-- | Find a @'Device'@ in cache matching the given tag and value. +findDeviceWithTag :: MonadIO m => String -> String -> CacheT m (Maybe Device) +findDeviceWithTag typ val = + CacheT $ StateT $ \c -> + do mdev <- liftIO $ withCString typ $ \t -> + withCString val $ \v -> + find_dev_with_tag c t v >>= maybePeek toDevice + return (mdev,c) + +-- | Flags for @'getDevice'@. +data DevFlags = Find + | Create + | Verify + | Normal + deriving (Eq, Show) + +fromDevFlags :: Num a => DevFlags -> a +fromDevFlags Find = #{const BLKID_DEV_FIND} +fromDevFlags Create = #{const BLKID_DEV_CREATE} +fromDevFlags Verify = #{const BLKID_DEV_VERIFY} +fromDevFlags Normal = #{const BLKID_DEV_NORMAL} + +-- | Get the device in cache with the given name. +getDevice :: MonadIO m => String -> DevFlags -> CacheT m (Maybe Device) +getDevice nam fl = + CacheT $ StateT $ \c -> + do mdev <- liftIO $ withCString nam $ \n -> + get_dev c n (fromDevFlags fl) >>= maybePeek toDevice + return (mdev,c) + +-- | Get the device name of the device in cache matching the given tag +-- and value. +getDevname :: MonadIO m => String -> String -> CacheT m (Maybe String) +getDevname tok val = + CacheT $ StateT $ \c -> + do mstr <- liftIO $ withCString tok $ \t -> + withCString val $ \v -> + bracket (get_devname c t v) c_free (maybePeek peekCString) + return (mstr,c) + +-- | Get the value of a tag given the tag and device name. +getTagValue :: MonadIO m => String -> String -> CacheT m (Maybe String) +getTagValue tok nam = + CacheT $ StateT $ \c -> + do mstr <- liftIO $ withCString tok $ \t -> + withCString nam $ \n -> + bracket (get_tag_value c t n) c_free (maybePeek peekCString) + return (mstr,c) + +devIterate :: MonadIO m => Maybe String -> String -> CacheT m [Device] +devIterate mtok val = + CacheT $ StateT $ \c -> + do devs <- liftIO $ bracket (getIter c) dev_iterate_end getDev + return (devs,c) + where getIter p = do it <- dev_iterate_begin p + if it == nullPtr + then fail "blkid_dev_iterate_begin returned NULL" + else case mtok of + Nothing -> return it + Just tok -> + withCString tok $ \t -> + withCString val $ \v -> + do throwIfNeg_ (\e -> "blkid_dev_set_search returned " ++ show e) + (dev_set_search it t v) + return it + getDev it = alloca $ \pd -> do e <- dev_next it pd + if e < 0 + then return [] + else do d <- peek pd >>= toDevice + ds <- getDev it + return (d:ds) + +-- | Get the list of devices in cache. +getDevices :: MonadIO m => CacheT m [Device] +getDevices = devIterate Nothing [] + +-- | Get the list of devices in cache matching the given tag and value. +getDevicesWithTag :: MonadIO m => String -> String -> CacheT m [Device] +getDevicesWithTag tok val = devIterate (Just tok) val + +-- | Get the partition or filesystem device with the given @'Tag'@, +-- using the cache file. +evaluateTagUsingCache :: MonadIO m => Tag -> CacheT m (Maybe String) +evaluateTagUsingCache (Label str) = evalTag "LABEL" str +evaluateTagUsingCache (PartLabel str) = evalTag "PARTLABEL" str +evaluateTagUsingCache (UUID str) = evalTag "UUID" str +evaluateTagUsingCache (PartUUID str) = evalTag "PARTUUID" str + +evalTag :: MonadIO m => String -> String -> CacheT m (Maybe String) +evalTag tok val = + CacheT $ StateT $ \c -> + liftIO $ alloca $ \p -> + do poke p c + mstr <- bracket (withCString tok $ \t -> + withCString val $ \v -> + evaluate_tag t v p) + c_free + (maybePeek peekCString) + c' <- peek p + return (mstr,c') + +-- | Get the desired partition or filesystem device, using the cache +-- file. +evaluateSpecUsingCache :: MonadIO m => String -> CacheT m (Maybe String) +evaluateSpecUsingCache spec = + CacheT $ StateT $ \c -> + liftIO $ alloca $ \p -> + do poke p c + mstr <- bracket (withCString spec $ \s -> evaluate_spec s p) + c_free + (maybePeek peekCString) + c' <- peek p + return (mstr,c') + +type BlkidDevIterate = Ptr DevIterate + +data DevIterate + +type BlkidTagIterate = Ptr TagIterate + +data TagIterate + +foreign import ccall "blkid_put_cache" put_cache :: BlkidCache -> IO () + +foreign import ccall "blkid_get_cache" get_cache :: Ptr BlkidCache + -> CString + -> IO CInt + +foreign import ccall "blkid_gc_cache" gc_cache :: BlkidCache -> IO () + +foreign import ccall "blkid_dev_devname" dev_devname :: BlkidDev -> IO CString + +foreign import ccall "blkid_dev_iterate_begin" + dev_iterate_begin :: BlkidCache -> IO BlkidDevIterate + +foreign import ccall "blkid_dev_set_search" dev_set_search :: BlkidDevIterate + -> CString + -> CString + -> IO CInt + +foreign import ccall "blkid_dev_next" dev_next :: BlkidDevIterate + -> Ptr BlkidDev + -> IO CInt + +foreign import ccall "blkid_dev_iterate_end" dev_iterate_end :: BlkidDevIterate + -> IO () + +foreign import ccall "blkid_probe_all" probe_all :: BlkidCache -> IO CInt + +foreign import ccall "blkid_probe_all_new" probe_all_new :: BlkidCache + -> IO CInt + +foreign import ccall "blkid_probe_all_removable" + probe_all_removable :: BlkidCache -> IO CInt + +foreign import ccall "blkid_get_dev" + get_dev :: BlkidCache -> CString -> CInt -> IO BlkidDev + +foreign import ccall "blkid_verify" + blkid_verify :: BlkidCache -> BlkidDev -> IO BlkidDev + +foreign import ccall "blkid_get_tag_value" + get_tag_value :: BlkidCache -> CString -> CString -> IO CString + +foreign import ccall "blkid_get_devname" + get_devname :: BlkidCache -> CString -> CString -> IO CString + +foreign import ccall "blkid_tag_iterate_begin" + tag_iterate_begin :: BlkidDev -> IO BlkidTagIterate + +foreign import ccall "blkid_tag_next" + tag_next :: BlkidTagIterate -> Ptr CString -> Ptr CString -> IO CInt + +foreign import ccall "blkid_tag_iterate_end" + tag_iterate_end :: BlkidTagIterate -> IO () + +foreign import ccall "blkid_dev_has_tag" + dev_has_tag :: BlkidDev -> CString -> CString -> IO CInt + +foreign import ccall "blkid_find_dev_with_tag" + find_dev_with_tag :: BlkidCache -> CString -> CString -> IO BlkidDev + +foreign import ccall "blkid_evaluate_tag" evaluate_tag :: CString + -> CString + -> Ptr BlkidCache + -> IO CString + +foreign import ccall "blkid_evaluate_spec" evaluate_spec :: CString + -> Ptr BlkidCache + -> IO CString diff --git a/System/Linux/Blkid/Evaluate.hsc b/System/Linux/Blkid/Evaluate.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/Blkid/Evaluate.hsc @@ -0,0 +1,110 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Tags and Spec evaluation. +module System.Linux.Blkid.Evaluate + ( Tag(..) + , evaluateTag +-- , evaluateTagUsingCache + , evaluateSpec +-- , evaluateSpecUsingCache + ) where + +import Control.Exception (bracket) +import Control.Monad.IO.Class +import Foreign +import Foreign.C + +#include + +foreign import ccall "stdlib.h free" + c_free :: Ptr a -> IO () + +type BlkidCache = Ptr BlkidStructCache + +data BlkidStructCache + +-- | Partition or filesystem tag. +data Tag = Label String + | PartLabel String + | UUID String + | PartUUID String + deriving (Eq, Show) + +{- +evalTag :: MonadIO m => String -> String -> BlkidCache -> m (Maybe String) +evalTag tok val cac = + liftIO $ bracket $ + (withCString tok $ \t -> + withCString val $ \v -> + with cac \c -> + evaluate_tag t v c) + c_free + (maybePeek peekCString) +-} + +-- | Get the partition or filesystem device with the given @'Tag'@. +-- +-- Example: +-- +-- >>> evaluateTag (PartLabel "EFI System Partition") +-- Just "/dev/sda1" +evaluateTag :: MonadIO m => Tag -> m (Maybe String) +evaluateTag (Label str) = liftIO $ evalTag "LABEL" str +evaluateTag (PartLabel str) = liftIO $ evalTag "PARTLABEL" str +evaluateTag (UUID str) = liftIO $ evalTag "UUID" str +evaluateTag (PartUUID str) = liftIO $ evalTag "PARTUUID" str + +evalTag :: String -> String -> IO (Maybe String) +evalTag tok val = + bracket (withCString tok $ \t -> + withCString val $ \v -> + evaluate_tag t v nullPtr) + c_free + (maybePeek peekCString) +{- +evaluateTagUsingCache :: MonadIO m => String -> String -> CacheT m (Maybe String) +evaluateTagUsingCache tok val = + CacheT $ StateT $ \c -> + do mstr <- evalTag tok val c + return (mstr,c) + +evalSpec :: MonadIO m => String -> Ptr BlkidCache -> m (Maybe String) +evalSpec spec c = + liftIO $ bracket + (withCString spec $ \s -> evaluate_spec s c) + c_free + (maybePeek peekCString) +-} + +-- | Get the desired partition or filesystem device. +-- +-- Examples: +-- +-- >>> evaluateSpec "LABEL=EFI" +-- Just "/dev/sda1" +-- +-- >>> evaluateSpec "/dev/disk/by-label/EFI" +-- Just "/dev/sda1" +evaluateSpec :: MonadIO m => String -> m (Maybe String) +evaluateSpec spec = + liftIO $ bracket + (withCString spec $ \s -> evaluate_spec s nullPtr) + c_free + (maybePeek peekCString) + +{- +evaluateSpecUsingCache :: MonadIO m => String -> CacheT m (Maybe String) +evaluateSpecUsingCache spec = + CacheT $ StateT $ \c -> + do mstr <- evalSpec spec c + return (mstr,c) +-} +foreign import ccall "blkid_evaluate_tag" evaluate_tag :: CString + -> CString + -> Ptr BlkidCache + -> IO CString + +foreign import ccall "blkid_evaluate_spec" evaluate_spec :: CString + -> Ptr BlkidCache + -> IO CString diff --git a/System/Linux/Blkid/Probe.hsc b/System/Linux/Blkid/Probe.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/Blkid/Probe.hsc @@ -0,0 +1,1003 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Low-level probing functions. +module System.Linux.Blkid.Probe + ( -- * Low-level probing + Probe +-- , ProbeT +-- , useProbe + , newProbe + , newProbeFromFilename + , probeGetDevno + , probeGetFd + , probeGetSectorsize + , probeGetSectors + , probeGetSize + , probeGetOffset + , probeGetWholediskDevno + , probeSetDevice + , probeIsWholedisk + , resetProbe + -- * Low-level tags + , doProbe + , doFullprobe + , doSafeprobe + , doWipe + , probeGetValues + , probeHasValue + , probeLookupValue + -- * Miscellaneous utils + , Offset + , Size + -- * Topology information + , Topology (..) + , probeEnableTopology + , probeGetTopology + -- * Superblocks probing + , probeEnableSuperblocks + , knownFstype + , superblocksGetName + , probeFilterSuperblocksTypeNotIn + , probeFilterSuperblocksTypeOnlyIn + , Usage (..) + , probeFilterSuperblocksUsageNotIn + , probeFilterSuperblocksUsageOnlyIn + , probeInvertSuperblocksFilter + , probeResetSuperblocksFilter + , Superblock(..) + , defaultSuperblock + , probeSetSuperblocksFlags + -- * Partitions probing + , Partition(..) +-- , Partlist + , PartTable(..) + , probeEnablePartitions + , PartsFlags(..) + , probeSetPartitionsFlags + , probeFilterPartitionsTypeNotIn + , probeFilterPartitionsTypeOnlyIn + , probeInvertPartitionsFilter + , probeResetPartitionsFilter + , knownPttype +{- + , partitionGetName + , partitionGetFlags + , partitionGetPartno + , partitionGetSize + , partitionGetStart + , partitionGetTable + , partitionGetType + , partitionGetTypeString + , partitionGetUUID + , partitionIsExtended + , partitionIsLogical + , partitionIsPrimary +-} + , probeDevnoToPartition +{- + , parttableGetOffset + , parttableGetParent + , parttableGetType +-} +-- , probeGetPartitions + , probeGetPartList + ) where + +import Control.Exception (bracket) +--import Control.Monad.IO.Class +--import Control.Monad.Trans.Class +--import Control.Monad.Trans.State +import Foreign +import Foreign.C +import System.Linux.Blkid.Utils (Size) +import System.Posix.Types (CDev(..), Fd(..)) + +#include +{- +newtype ProbeT m a = ProbeT { runProbeT :: StateT BlkidProbe m a} + +instance MonadTrans ProbeT where + lift = ProbeT . lift + +instance Functor f => Functor (ProbeT f) where + fmap f = ProbeT . (fmap f) . runProbeT + +instance Monad m => Monad (ProbeT m) where + return = ProbeT . return + (ProbeT m) >>= f = ProbeT (m >>= runProbeT . f) + fail = ProbeT . fail + +instance MonadIO m => MonadIO (ProbeT m) where + liftIO = ProbeT . liftIO + +useProbe :: MonadIO m => FilePath -> ProbeT m a -> m a +useProbe path (ProbeT f) = + do pr <- liftIO $ withCString path $ \p -> + throwIfNull "blkid_new_probe_from_filename returned NULL" $ + new_probe_from_filename p + (a,pr') <- runStateT f pr + liftIO $ free_probe pr' + return a +-} +foreign import ccall "stdlib.h free" + c_free :: Ptr a -> IO () + +type BlkidProbe = Ptr Probe + +-- | Low-level probing setting. +newtype Probe = Probe (ForeignPtr Probe) + +withProbe :: Probe -> (Ptr Probe -> IO a) -> IO a +withProbe (Probe p) = withForeignPtr p + +toProbe :: Ptr Probe -> IO Probe +toProbe p = newForeignPtr p_free_probe p >>= return . Probe + +type BlkidTopology = Ptr Topology + +-- | Offset of a device or partition. +type Offset = Word64 + +-- | Data structure for topology information. +data Topology = Topology { alignmentOffset :: Offset + , minimumIOSize :: Size + , optimalIOSize :: Size + , logicalSectorSize :: Size + , physicalSectorSize :: Size + } deriving (Eq, Show) + +type BlkidPartlist = Ptr Partlist + +data Partlist + +type BlkidParttable = Ptr PartTable + +type BlkidPartition = Ptr Partition + +-- | The information about a partition as returned by +-- @'probeDevnoToPartition'@ and @'probeGetPartList'@. +data Partition = Partition + { partitionStart :: Offset + , partitionSize :: Size + , partitionType :: Int -- ^ Partition type. + , partitionTypeStr :: Maybe String -- ^ Partition type string or + -- @'Nothing'@. The type + -- string is supported by a + -- small subset of partition + -- tables (e.g Mac and EFI + -- GPT). Note that GPT uses + -- type UUID and this + -- function returns this UUID + -- as string. + , partitionFlags :: Word64 -- ^ Partition flags (or attributes + -- for @gpt@). + , partitionNumber :: Int -- ^ Proposed partition number + -- (e.g. 'N' from sda'N') or + -- @'Control.Exception.throw'@ an + -- error. Note that the number is + -- generated by library independenly + -- on your OS. + , partitionUUID :: Maybe String -- ^ Partition UUID string if + -- supported by partition + -- table (e.g. GPT) or + -- @'Nothing'@. + , partitionName :: Maybe String -- ^ Partition name if + -- supported by partition + -- table (e.g. Mac) or + -- @'Nothing'@. + , partitionPartTable :: PartTable + , isExtended :: Bool -- ^ Check if partition is extended (dos, + -- windows or linux) partition. + , isLogical :: Bool -- ^ Check if partition is logical partition. + -- + -- Note: that this function returns @'True'@ + -- for all partitions in all nested partition + -- tables (e.g. BSD labels). + , isPrimary :: Bool -- ^ Check if partition is primary partition. + -- + -- Note: this function returns @'False'@ for + -- DOS extended partitions and all partitions + -- in nested partition tables. + } deriving (Eq, Show) + +toPartition :: BlkidPartition -> IO Partition +toPartition p = + do sta <- partition_get_start p >>= return . fromIntegral + siz <- partition_get_size p >>= return . fromIntegral + typ <- partition_get_type p >>= return . fromIntegral + str <- partition_get_type_string p >>= maybePeek peekCString + fla <- partition_get_flags p >>= return . fromIntegral + pno <- partition_get_partno p >>= return . fromIntegral + uuid <- partition_get_uuid p >>= maybePeek peekCString + nam <- partition_get_name p >>= maybePeek peekCString + tab <- partition_get_table p >>= toPartTable + ext <- partition_is_extended p >>= return . toBool + logi <- partition_is_logical p >>= return . toBool + pri <- partition_is_primary p >>= return . toBool + return $ Partition sta siz typ str fla pno uuid nam tab ext logi pri + +-- | The information about a partition table, as returned by +-- @'probeGetPartList'@. +data PartTable = PartTable + { parttableType :: String -- ^ Partition table type (type name, + -- e.g. \"dos\", \"gpt\", ...). + , parttableOffset :: Offset -- ^ Position (in bytes) of the + -- partition table. + -- + -- Note: the position is relative to + -- begin of the device as defined by + -- @'probeSetDevice'@ for primary + -- partition table, and relative to + -- parental partition for nested + -- patition tables. + , parttableParent :: Maybe Partition -- ^ Parent for nested + -- partitition tables or + -- @'Nothing'@. + } deriving (Eq, Show) + +toPartTable :: BlkidParttable -> IO PartTable +toPartTable pt = + do typ <- parttable_get_type pt >>= peekCString + off <- parttable_get_offset pt >>= return . fromIntegral + par <- parttable_get_parent pt >>= maybePeek toPartition + return $ PartTable typ off par + +-- | Usage filter to use with @'probeFilterSuperblocksUsageNotIn'@ and +-- @'probeFilterSuperblocksUsageOnlyIn'@. +data Usage = Filesystem + | Raid + | Crypto + | Other + deriving (Eq, Show) + +fromUsage :: Num a => Usage -> a +fromUsage Filesystem = #{const BLKID_USAGE_FILESYSTEM} +fromUsage Raid = #{const BLKID_USAGE_RAID} +fromUsage Crypto = #{const BLKID_USAGE_CRYPTO} +fromUsage Other = #{const BLKID_USAGE_OTHER} + +toUsage :: (Eq a, Num a) => a -> Maybe Usage +toUsage #{const BLKID_USAGE_FILESYSTEM} = Just Filesystem +toUsage #{const BLKID_USAGE_RAID} = Just Raid +toUsage #{const BLKID_USAGE_CRYPTO} = Just Crypto +toUsage #{const BLKID_USAGE_OTHER} = Just Other +toUsage _ = Nothing + + +-- | Create a new @'Probe'@ data structure, to use with +-- @'probeSetDevice'@. +newProbe :: IO Probe +newProbe = do p <- new_probe + if p == nullPtr + then fail "blkid_new_probe returned NULL" + else toProbe p + +-- | This function is same as +-- +-- > \path -> do fd <- openFd path ReadOnly Nothing defaultFileFlags +-- > pr <- newProbe +-- > probeSetDevice pr fd 0 0 +-- > return pr +newProbeFromFilename :: FilePath -> IO Probe +newProbeFromFilename path = + withCString path $ \cstr -> + do p <- new_probe_from_filename cstr + if p == nullPtr + then fail "blkid_new_probe_from_filename returned NULL" + else toProbe p + +-- | Get the device number of the probed device. +probeGetDevno :: Probe -> IO (Maybe CDev) +probeGetDevno pr = withProbe pr $ \p -> do d <- probe_get_devno p + case d of + 0 -> return Nothing + _ -> return $ Just d + +-- | Get the file descriptor of the probed device. +probeGetFd :: Probe -> IO Fd +probeGetFd pr = withProbe pr $ \p -> probe_get_fd p >>= return . Fd + +-- | Get the logical sector size of the probed device. +probeGetSectorsize :: Maybe Probe -> IO Word +probeGetSectorsize mpr = + maybeWith withProbe mpr $ \p -> probe_get_sectorsize p >>= return . fromIntegral + +-- | Get the 512-byte sector count of the probed device. +probeGetSectors :: Probe -> IO Word64 +probeGetSectors pr = + withProbe pr $ \p -> + throwIfNeg (\e -> "blkid_probe_get_sectors returned " ++ show e) (probe_get_sectors p) >>= return . fromIntegral + +-- | Return the size in bytes of the probing area as defined by +-- @'probeSetDevice'@. If the size of the probing area is unrestricted +-- then this function returns the real size of device. See also +-- @'System.Linux.Blkid.Utils.getDevSize'@. +probeGetSize :: Probe -> IO Size +probeGetSize pr = + withProbe pr $ \p -> + throwIfNeg (\e -> "blkid_probe_get_size returned " ++ show e) (probe_get_size p) >>= return . fromIntegral + +-- | Return the offset in bytes of the probing area as defined by +-- @'probeSetDevice'@. +probeGetOffset :: Probe -> IO Offset +probeGetOffset pr = + withProbe pr $ \p -> + throwIfNeg (\e -> "blkid_probe_get_offset returned " ++ show e) (probe_get_offset p) >>= return . fromIntegral + +-- | Return device number of the wholedisk, or 0 for regular files. +probeGetWholediskDevno :: Probe -> IO (Maybe CDev) +probeGetWholediskDevno pr = + withProbe pr $ \p -> do d <- probe_get_wholedisk_devno p + case d of + 0 -> return Nothing + _ -> return $ Just d + +-- | Assigns the device to @'Probe'@ control struct, resets internal +-- buffers and resets the current probing. +probeSetDevice :: Probe + -> Fd -- ^ Device file descriptor + -> Offset -- ^ Begin of probing area + -> Size -- ^ Size of probing area (zero means whole + -- device/file) + -> IO () +probeSetDevice pr (Fd n) off size = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_set_device returned " ++ show e) + (probe_set_device p n (fromIntegral off) (fromIntegral size)) + +-- | Check if device is whole-disk. +probeIsWholedisk :: Probe -> IO Bool +probeIsWholedisk pr = + withProbe pr $ \p -> probe_is_wholedisk p >>= return . toEnum . fromIntegral + +-- | Zeroize probing results and resets the current probing (this has +-- impact to @'doProbe'@ only). This function does not touch probing +-- filters and keeps assigned device. +resetProbe :: Probe -> IO () +resetProbe pr = withProbe pr reset_probe + +-- | Enable/disable the topology probing for non-binary interface. +probeEnableTopology :: Probe -> Bool -> IO () +probeEnableTopology pr b = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_enable_topology returned " ++ show e) + (probe_enable_topology p (fromBool b)) + +-- | Get topology information. +-- +-- This function is independent on @'doProbe'@, @'doSafeprobe'@, +-- @'doFullprobe'@ and @'probeEnableTopology'@ functions. +probeGetTopology :: Probe -> IO Topology +probeGetTopology pr = + withProbe pr $ \p -> bracket + (probe_get_topology p) + c_free + (\t -> + if t == nullPtr + then fail "blkid_probe_get_topology returned NULL" + else do ao <- topology_get_alignment_offset t + mio <- topology_get_minimum_io_size t + oio <- topology_get_optimal_io_size t + ls <- topology_get_logical_sector_size t + ps <- topology_get_physical_sector_size t + return (Topology + (fromIntegral ao) + (fromIntegral mio) + (fromIntegral oio) + (fromIntegral ls) + (fromIntegral ps) + )) + +-- | Enable/disable the superblocks probing for non-binary interface. +probeEnableSuperblocks :: Probe -> Bool -> IO () +probeEnableSuperblocks pr b = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_enable_superblocks returned " ++ show e) + (probe_enable_superblocks p (fromBool b)) + +-- | Check if the filesystem is of known type. +knownFstype :: String -> IO Bool +knownFstype str = + withCString str $ \cstr -> known_fstype cstr >>= return . toBool + +-- | Table of superblocks name and usage. +superblocksGetName :: CSize -> IO (Maybe (String, Usage)) +superblocksGetName s = alloca $ \p -> + alloca $ \q -> do + e <- superblocks_get_name s p q + case e of + 0 -> do str <- peek p >>= peekCString + i <- peek q + let Just u = toUsage i + return $ Just (str, u) + _ -> return Nothing + +withCStringArray :: [String] -> (Ptr CString -> IO a) -> IO a +withCStringArray xs f = bracket + (mapM newCString xs) + (mapM_ free) + (\ps -> withArray0 nullPtr ps f) + +probeFilterSuperblocksType :: CInt -> [String] -> Probe -> IO () +probeFilterSuperblocksType fl xs pr = + withProbe pr $ \p -> + withCStringArray xs $ \cs -> + throwIfNeg_ (\e -> "blkid_probe_filter_superblocks_type returned " ++ show e) + (probe_filter_superblocks_type p fl cs) + +-- | Probe for all superblocks whose type is not in the list. +probeFilterSuperblocksTypeNotIn :: [String] -> Probe -> IO () +probeFilterSuperblocksTypeNotIn = + probeFilterSuperblocksType #{const BLKID_FLTR_NOTIN} + +-- | Probe only for superblocks whose type is in the list. +probeFilterSuperblocksTypeOnlyIn :: [String] -> Probe -> IO () +probeFilterSuperblocksTypeOnlyIn = + probeFilterSuperblocksType #{const BLKID_FLTR_ONLYIN} + +probeFilterSuperblocksUsage :: CInt -> [Usage] -> Probe -> IO () +probeFilterSuperblocksUsage fl us pr = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_filter_superblocks_usage returned " ++ show e) + (probe_filter_superblocks_usage p fl (foldl1 (.|.) $ map fromUsage us)) + +-- | Probe for all superblocks whose @'Usage'@ is not in the list. +probeFilterSuperblocksUsageNotIn :: [Usage] -> Probe -> IO () +probeFilterSuperblocksUsageNotIn = + probeFilterSuperblocksUsage #{const BLKID_FLTR_NOTIN} + +-- | Probe only for superblocks whose @'Usage'@ is in the list. +probeFilterSuperblocksUsageOnlyIn :: [Usage] -> Probe -> IO () +probeFilterSuperblocksUsageOnlyIn = + probeFilterSuperblocksUsage #{const BLKID_FLTR_ONLYIN} + +-- | Invert superblocks probing filter. +probeInvertSuperblocksFilter :: Probe -> IO () +probeInvertSuperblocksFilter pr = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_invert_superblocks_filter returned " ++ show e) (probe_invert_superblocks_filter p) + +-- | Reset superblocks probing filter. +probeResetSuperblocksFilter :: Probe -> IO () +probeResetSuperblocksFilter pr = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_reset_superblocks_filter returned " ++ show e) (probe_reset_superblocks_filter p) + +-- | Superblock probing flags. +data Superblock = Superblock { readLabel :: Bool + , readLabelRaw :: Bool + , readUUID :: Bool + , readUUIDRaw :: Bool + , readType :: Bool + , readSecType :: Bool + , readUsage :: Bool + , readVersion :: Bool + , readMagic :: Bool + } deriving (Eq, Show) + +-- | Default superblock flags. +defaultSuperblock :: Superblock +defaultSuperblock = Superblock True False True False True True False False False + +fromSuperblock :: (Bits a, Num a) => Superblock -> a +fromSuperblock (Superblock l lr u ur t st us v m) = + (if l then #{const BLKID_SUBLKS_LABEL} else 0) .|. + (if lr then #{const BLKID_SUBLKS_LABELRAW} else 0) .|. + (if u then #{const BLKID_SUBLKS_UUID} else 0) .|. + (if ur then #{const BLKID_SUBLKS_UUIDRAW} else 0) .|. + (if t then #{const BLKID_SUBLKS_TYPE} else 0) .|. + (if st then #{const BLKID_SUBLKS_SECTYPE} else 0) .|. + (if us then #{const BLKID_SUBLKS_USAGE} else 0) .|. + (if v then #{const BLKID_SUBLKS_VERSION} else 0) .|. + (if m then #{const BLKID_SUBLKS_MAGIC} else 0) + +-- | Set probing flags to the superblocks prober. This function is +-- optional, the default is @'defaultSuperblock'@. +probeSetSuperblocksFlags :: Probe -> Superblock -> IO () +probeSetSuperblocksFlags pr s = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_set_superblocks_flags returned " ++ show e) + (probe_set_superblocks_flags p (fromSuperblock s)) + +-- | Enable/disable the partitions probing for non-binary interface. +probeEnablePartitions :: Probe -> Bool -> IO () +probeEnablePartitions pr b = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_enable_partitions returned " ++ show e) + (probe_enable_partitions p (fromBool b)) + +-- | Flags for @'probeSetPartitionsFlags'@. +data PartsFlags = PartsFlags { forceGPT :: Bool + , entryDetails :: Bool + , magic :: Bool + } deriving (Eq, Show) + +fromPartsFlags :: (Bits a, Num a) => PartsFlags -> a +fromPartsFlags (PartsFlags g d m) = + (if g then #{const BLKID_PARTS_FORCE_GPT} else 0) .|. + (if d then #{const BLKID_PARTS_ENTRY_DETAILS} else 0) .|. + (if m then #{const BLKID_PARTS_MAGIC} else 0) + +-- | Set probing flags to the partitions prober. This function is optional. +probeSetPartitionsFlags :: Probe -> PartsFlags -> IO () +probeSetPartitionsFlags pr fl = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_set_partitions_flags returned " ++ show e) + (probe_set_partitions_flags p (fromPartsFlags fl)) + +probeFilterPartitionsType :: CInt -> [String] -> Probe -> IO () +probeFilterPartitionsType i xs pr = + withProbe pr $ \p -> + withCStringArray xs $ \arr -> + throwIfNeg_ (\e -> "blkid_probe_filter_partitions_type returned " ++ show e) + (probe_filter_partitions_type p i arr) + +-- | Probe for all partitions whose type is not in the list. +probeFilterPartitionsTypeNotIn :: [String] -> Probe -> IO () +probeFilterPartitionsTypeNotIn = + probeFilterPartitionsType #{const BLKID_FLTR_NOTIN} + +-- | Probe only for partitions whose type is the list. +probeFilterPartitionsTypeOnlyIn :: [String] -> Probe -> IO () +probeFilterPartitionsTypeOnlyIn = + probeFilterPartitionsType #{const BLKID_FLTR_ONLYIN} + +-- | Invert partitions probing filter. +probeInvertPartitionsFilter :: Probe -> IO () +probeInvertPartitionsFilter pr = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_invert_partitions_filter returned " ++ show e) (probe_invert_partitions_filter p) + +-- | Reset partitions probing filter. +probeResetPartitionsFilter :: Probe -> IO () +probeResetPartitionsFilter pr = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_probe_reset_partitions_filter returned " ++ show e) (probe_reset_partitions_filter p) + +-- | Check if the partition if of known type. +knownPttype :: String -> IO Bool +knownPttype str = + withCString str $ \cstr -> known_pttype cstr >>= return . toBool +{- +-- | Get partition name if supported by partition table (e.g. Mac) or +-- @'Nothing'@. +partitionGetName :: Partition -> IO (Maybe String) +partitionGetName part = + withPartition part $ \p -> partition_get_name p >>= maybePeek peekCString + +-- | get partition flags (or attributes for @gpt@). +partitionGetFlags :: Partition -> IO Word64 +partitionGetFlags part = + withPartition part $ \p -> partition_get_flags p >>= return . fromIntegral + +-- | Proposed partitin number (e.g. 'N' from sda'N') or +-- @'Control.Exception.throw'@ an error. Note that the number is +-- generated by library independenly on your OS. +partitionGetPartno :: Partition -> IO Int +partitionGetPartno part = + withPartition part $ \p -> + throwIfNeg (\e -> "blkid_partition_get_partno returned " ++ show e) (partition_get_partno p) + >>= return . fromIntegral + +partitionGetSize :: Partition -> IO Size +partitionGetSize part = + withPartition part $ \p -> partition_get_size p >>= return . fromIntegral + +partitionGetStart :: Partition -> IO Offset +partitionGetStart part = + withPartition part $ \p -> partition_get_start p >>= return . fromIntegral + +partitionGetTable :: Partition -> IO PartTable +partitionGetTable part = withPartition part $ \p -> + do q <- partition_get_table p + if q == nullPtr + then fail + "blkid_partition_get_table returned NULL" + else toPartTable q + +-- | Get partition type. +partitionGetType :: Partition -> IO Int +partitionGetType part = + withPartition part $ \p -> partition_get_type p >>= return . fromIntegral + +-- | Get partition type string or @'Nothing'@. The type string is +-- supported by a small subset of partition tables (e.g Mac and EFI +-- GPT). Note that GPT uses type UUID and this function returns this +-- UUID as string. +partitionGetTypeString :: Partition -> IO (Maybe String) +partitionGetTypeString part = + withPartition part $ \p -> + partition_get_type_string p >>= maybePeek peekCString + +-- | Get partition UUID string if supported by partition table +-- (e.g. GPT) or @'Nothing'@. +partitionGetUUID :: Partition -> IO (Maybe String) +partitionGetUUID part = + withPartition part $ \p -> partition_get_uuid p >>= maybePeek peekCString + +-- | Check if partition is extended (dos, windows or linux) partition. +partitionIsExtended :: Partition -> IO Bool +partitionIsExtended part = + withPartition part $ \p -> partition_is_extended p >>= return . toBool + +-- | Check if partition is logical partition. +-- +-- Note: that this function returns @'True'@ for all partitions in all +-- nested partition tables (e.g. BSD labels). +partitionIsLogical :: Partition -> IO Bool +partitionIsLogical part = + withPartition part $ \p -> partition_is_logical p >>= return . toBool + +-- | Check if partition is primary partition. +-- +-- Note: this function returns @'False'@ for DOS extended partitions +-- and all partitions in nested partition tables. +partitionIsPrimary :: Partition -> IO Bool +partitionIsPrimary part = + withPartition part $ \p -> partition_is_primary p >>= return . toBool +-} +-- | This function tries to get start and size for devno from @sysfs@ +-- and returns a partition which matches with the values from @sysfs@. +-- +-- This function is independent on @'doProbe'@, @'doSafeprobe'@, +-- @'doFullprobe'@ and @'probeEnablePartitions'@ functions. +probeDevnoToPartition :: Probe -> CDev -> IO (Maybe Partition) +probeDevnoToPartition pr d = + withProbe pr $ \p -> + do pl <- throwIfNull "blkid_probe_get_partitions returned NULL" $ + probe_get_partitions p + partlist_devno_to_partition pl d >>= maybePeek toPartition +{- +-- | Get the position (in bytes) of the partition table. +-- +-- Note: the position is relative to begin of the device as defined by +-- @'probeSetDevice'@ for primary partition table, and relative to +-- parental partition for nested patition tables. +parttableGetOffset :: PartTable -> IO Offset +parttableGetOffset pt = + withPartTable pt $ \p -> parttable_get_offset p >>= return . fromIntegral + +-- | Get parent for nexted partitition tables or @'Nothing'@. +parttableGetParent :: PartTable -> IO (Maybe Partition) +parttableGetParent pt = + withPartTable pt $ \p -> parttable_get_parent p >>= maybePeek toPartition + +-- | Get partition table type (type name, e.g. \"dos\", \"gpt\", ...). +parttableGetType :: PartTable -> IO String +parttableGetType pt = + withPartTable pt $ \p -> parttable_get_type p >>= peekCString +-} +-- | Get partition list. +-- +-- This function is independent on @'doProbe'@, @'doSafeprobe'@, +-- @'doFullprobe'@ and @'probeEnablePartitions'@ functions. +probeGetPartList :: Probe -> IO (Maybe PartTable, [Partition]) +probeGetPartList pr = + withProbe pr $ \p -> + do pl <- throwIfNull "blkid_probe_get_partitions returned NULL" $ + probe_get_partitions p + mpt <- partlist_get_table pl >>= maybePeek toPartTable + n <- partlist_numof_partitions pl + parts <- mapM (getPart pl) [0..n-1] + return (mpt, parts) + where getPart plist i = + throwIfNull "blkid_partlist_get_partition returned NULL" + (partlist_get_partition plist i) >>= toPartition + +-- | Get the list of probed @(key,value)@ pairs. +probeGetValues :: Probe -> IO [(String,String)] +probeGetValues pr = + withProbe pr $ \p -> + do n <- throwIfNeg (\e -> "blkid_probe_numof_values returned " ++ + show e) $ probe_numof_values p + if n == 0 + then return [] + else mapM (getValue p) [0..n-1] + where getValue r i = + alloca $ \pn -> + alloca $ \pd -> + alloca $ \ps -> + do throwIfNeg_ (\e -> "blkid_probe_get_value returned " ++ show e) + (probe_get_value r i pn pd ps) + n <- peek pn >>= peekCString + d <- peek pd >>= peekCString + return (n,d) + +-- | Test if a given key has a value. +probeHasValue :: Probe -> String -> IO Bool +probeHasValue pr str = + withProbe pr $ \p -> + withCString str $ \cstr -> + probe_has_value p cstr >>= return . toBool + +-- | Lookup the value for the given key, and return it if present. +probeLookupValue :: Probe -> String -> IO (Maybe String) +probeLookupValue pr str = + withProbe pr $ \p -> + withCString str $ \cstr -> + alloca $ \pd -> + alloca $ \ps -> + do e <- probe_lookup_value p cstr pd ps + case e of + 0 -> peek pd >>= peekCString >>= return . Just + (-1) -> return Nothing + _ -> fail + ("blkid_probe_lookup_value returned " ++ show e) + +-- | This function erases the current signature detected by +-- @'Probe'@. The @'Probe'@ has to be open in +-- @'System.Posix.IO.ReadWrite'@ mode, and either use +-- @'probeSetSuperblocksFlags'@ with @'readMagic'@ set to @'True'@, or +-- use @'probeSetPartitionsFlags'@ with @'magic'@ set to @'True'@. +-- +-- After successful signature removing the @'Probe'@ will be moved one +-- step back and the next @'doProbe'@ call will again call previously +-- called probing function. +doWipe :: Probe -> Bool -> IO () +doWipe pr b = + withProbe pr $ \p -> + throwIfNeg_ (\e -> "blkid_do_wipe returned " ++ show e) (do_wipe p (fromBool b)) + +-- | Call probing functions in all enabled chains. The superblocks +-- chain is enabled by default. @'doProbe'@ stores result from only +-- one probing function. Use @'probeGetValues'@ to get results from +-- all probing functions in all chains. The probing is reset by +-- @'resetProbe'@ or by filter functions. +-- +-- This is string-based @(key,value)@ interface only. +doProbe :: Probe -> IO Bool +doProbe pr = + withProbe pr $ \p -> + throwIfNeg (\e -> "blkid_do_probe returned " ++ show e) (do_probe p) + >>= return . not . toBool + +-- | This function gathers probing results from all enabled +-- chains. Same as @'doSafeprobe'@ but does not check for collision +-- between probing result. +-- +-- This is string-based @(key,value)@ interface only. +doFullprobe :: Probe -> IO Bool +doFullprobe pr = + withProbe pr $ \p -> + throwIfNeg (\e -> "blkid_do_fullprobe returned " ++ show e) + (do_fullprobe p) >>= return . not . toBool + +-- | This function gathers probing results from all enabled chains and checks for ambivalent results (e.g. more filesystems on the device). +-- +-- This is string-based @(key,value)@ interface only. +-- +-- Note about suberblocks chain: the function does not check for +-- filesystems when a RAID signature is detected. The function also +-- does not check for collision between RAIDs. The first detected RAID +-- is returned. The function checks for collision between partition +-- table and RAID signature -- it's recommended to enable partitions +-- chain together with superblocks chain. +doSafeprobe :: Probe + -> IO (Maybe Bool) -- ^ @'Just' 'True'@ on success, + -- @'Just' 'False'@ if nothing is + -- detected, @'Nothing'@ if ambivalent + -- result is detected. +doSafeprobe pr = + withProbe pr $ \p -> + do n <- do_safeprobe p + case n of + 1 -> return $ Just False + 0 -> return $ Just True + (-2) -> return Nothing + e -> fail ("blkid_do_safeprobe returned " ++ show e) + +type BlkidLoff = #{type blkid_loff_t} + +{- +foreign import ccall "blkid_parse_tag_string" + parse_tag_string :: CString -> Ptr CString -> Ptr CString -> IO CInt + +foreign import ccall "blkid_parse_version_string" + parse_version_string :: CString -> IO CInt + +foreign import ccall "blkid_get_library_version" + get_library_version :: Ptr CString -> Ptr CString -> IO CInt + +foreign import ccall "blkid_encode_string" encode_string :: CString + -> CString + -> CSize + -> IO CInt + +foreign import ccall "blkid_safe_string" safe_string :: CString + -> CString + -> CSize + -> IO CInt +-} +foreign import ccall "blkid_new_probe" new_probe :: IO BlkidProbe + +foreign import ccall "blkid_new_probe_from_filename" + new_probe_from_filename :: CString -> IO BlkidProbe + +foreign import ccall "&blkid_free_probe" + p_free_probe :: FunPtr (BlkidProbe -> IO ()) + +--foreign import ccall "blkid_free_probe" free_probe :: BlkidProbe -> IO () + +foreign import ccall "blkid_reset_probe" reset_probe :: BlkidProbe + -> IO () + +foreign import ccall "blkid_probe_set_device" probe_set_device :: BlkidProbe + -> CInt + -> BlkidLoff + -> BlkidLoff + -> IO CInt + +foreign import ccall "blkid_probe_get_devno" probe_get_devno :: BlkidProbe + -> IO CDev + +foreign import ccall "blkid_probe_get_wholedisk_devno" + probe_get_wholedisk_devno :: BlkidProbe -> IO CDev + +foreign import ccall "blkid_probe_is_wholedisk" probe_is_wholedisk :: BlkidProbe + -> IO CInt + +foreign import ccall "blkid_probe_get_size" probe_get_size :: BlkidProbe + -> IO BlkidLoff + +foreign import ccall "blkid_probe_get_offset" probe_get_offset :: BlkidProbe + -> IO BlkidLoff + +foreign import ccall "blkid_probe_get_sectorsize" + probe_get_sectorsize :: BlkidProbe -> IO CUInt + +foreign import ccall "blkid_probe_get_sectors" probe_get_sectors :: BlkidProbe + -> IO BlkidLoff + +foreign import ccall "blkid_probe_get_fd" probe_get_fd :: BlkidProbe + -> IO CInt + +foreign import ccall "blkid_known_fstype" known_fstype :: CString -> IO CInt + +foreign import ccall "blkid_superblocks_get_name" + superblocks_get_name :: CSize -> Ptr CString -> Ptr CInt -> IO CInt + +foreign import ccall "blkid_probe_enable_superblocks" + probe_enable_superblocks :: BlkidProbe -> CInt -> IO CInt + +foreign import ccall "blkid_probe_set_superblocks_flags" + probe_set_superblocks_flags :: BlkidProbe -> CInt -> IO CInt + +foreign import ccall "blkid_probe_reset_superblocks_filter" + probe_reset_superblocks_filter :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_invert_superblocks_filter" + probe_invert_superblocks_filter :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_filter_superblocks_type" + probe_filter_superblocks_type :: BlkidProbe -> CInt -> Ptr CString -> IO CInt + +foreign import ccall "blkid_probe_filter_superblocks_usage" + probe_filter_superblocks_usage :: BlkidProbe -> CInt -> CInt -> IO CInt + +foreign import ccall "blkid_probe_enable_topology" + probe_enable_topology :: BlkidProbe -> CInt -> IO CInt + +foreign import ccall "blkid_probe_get_topology" + probe_get_topology :: BlkidProbe -> IO BlkidTopology + +foreign import ccall "blkid_topology_get_alignment_offset" + topology_get_alignment_offset :: BlkidTopology -> IO CUInt + +foreign import ccall "blkid_topology_get_minimum_io_size" + topology_get_minimum_io_size :: BlkidTopology -> IO CUInt + +foreign import ccall "blkid_topology_get_optimal_io_size" + topology_get_optimal_io_size :: BlkidTopology -> IO CUInt + +foreign import ccall "blkid_topology_get_logical_sector_size" + topology_get_logical_sector_size :: BlkidTopology -> IO CUInt + +foreign import ccall "blkid_topology_get_physical_sector_size" + topology_get_physical_sector_size :: BlkidTopology -> IO CUInt + +foreign import ccall "blkid_known_pttype" known_pttype :: CString -> IO CInt + +foreign import ccall "blkid_probe_enable_partitions" + probe_enable_partitions :: BlkidProbe -> CInt -> IO CInt + +foreign import ccall "blkid_probe_reset_partitions_filter" + probe_reset_partitions_filter :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_invert_partitions_filter" + probe_invert_partitions_filter :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_filter_partitions_type" + probe_filter_partitions_type :: BlkidProbe -> CInt -> Ptr CString -> IO CInt + +foreign import ccall "blkid_probe_set_partitions_flags" + probe_set_partitions_flags :: BlkidProbe -> CInt -> IO CInt + +foreign import ccall "blkid_probe_get_partitions" + probe_get_partitions :: BlkidProbe -> IO BlkidPartlist + +foreign import ccall "blkid_partlist_numof_partitions" + partlist_numof_partitions :: BlkidPartlist -> IO CInt + +foreign import ccall "blkid_partlist_get_table" + partlist_get_table :: BlkidPartlist -> IO BlkidParttable + +foreign import ccall "blkid_partlist_get_partition" + partlist_get_partition :: BlkidPartlist -> CInt -> IO BlkidPartition + +foreign import ccall "blkid_partlist_devno_to_partition" + partlist_devno_to_partition :: BlkidPartlist -> CDev -> IO BlkidPartition + +foreign import ccall "blkid_partition_get_table" + partition_get_table :: BlkidPartition -> IO BlkidParttable + +foreign import ccall "blkid_partition_get_name" + partition_get_name :: BlkidPartition -> IO CString + +foreign import ccall "blkid_partition_get_uuid" + partition_get_uuid :: BlkidPartition -> IO CString + +foreign import ccall "blkid_partition_get_partno" + partition_get_partno :: BlkidPartition -> IO CInt + +foreign import ccall "blkid_partition_get_start" + partition_get_start :: BlkidPartition -> IO BlkidLoff + +foreign import ccall "blkid_partition_get_size" + partition_get_size :: BlkidPartition -> IO BlkidLoff + +foreign import ccall "blkid_partition_get_type" + partition_get_type :: BlkidPartition -> IO CInt + +foreign import ccall "blkid_partition_get_type_string" + partition_get_type_string :: BlkidPartition -> IO CString + +foreign import ccall "blkid_partition_get_flags" + partition_get_flags :: BlkidPartition -> IO CULLong + +foreign import ccall "blkid_partition_is_logical" + partition_is_logical :: BlkidPartition -> IO CInt + +foreign import ccall "blkid_partition_is_extended" + partition_is_extended :: BlkidPartition -> IO CInt + +foreign import ccall "blkid_partition_is_primary" + partition_is_primary :: BlkidPartition -> IO CInt + +foreign import ccall "blkid_parttable_get_type" + parttable_get_type :: BlkidParttable -> IO CString + +foreign import ccall "blkid_parttable_get_offset" + parttable_get_offset :: BlkidParttable -> IO BlkidLoff + +foreign import ccall "blkid_parttable_get_parent" + parttable_get_parent :: BlkidParttable -> IO BlkidPartition + +foreign import ccall "blkid_do_probe" do_probe :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_do_safeprobe" do_safeprobe :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_do_fullprobe" do_fullprobe :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_numof_values" + probe_numof_values :: BlkidProbe -> IO CInt + +foreign import ccall "blkid_probe_get_value" probe_get_value :: BlkidProbe + -> CInt + -> Ptr CString + -> Ptr CString + -> Ptr CSize + -> IO CInt + +foreign import ccall "blkid_probe_lookup_value" probe_lookup_value :: BlkidProbe + -> CString + -> Ptr CString + -> Ptr CSize + -> IO CInt + +foreign import ccall "blkid_probe_has_value" probe_has_value :: BlkidProbe + -> CString + -> IO CInt + +foreign import ccall "blkid_do_wipe" do_wipe :: BlkidProbe -> CInt -> IO CInt + diff --git a/System/Linux/Blkid/Utils.hsc b/System/Linux/Blkid/Utils.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/Blkid/Utils.hsc @@ -0,0 +1,86 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Utilities for low-level and high-level API. +module System.Linux.Blkid.Utils + ( Size + , devnoToDevname + , devnoToWholedisk + , getDevSize + , libraryVersion + , libraryReleaseDate + , sendUevent + ) where + +import Control.Exception (bracket) +import Foreign +import Foreign.C +import System.Posix.Types (CDev(..), Fd(..)) + +#include + +foreign import ccall "stdlib.h free" + c_free :: Ptr a -> IO () + +type BlkidLoff = #{type blkid_loff_t} + +-- | Size of a device or partition. +type Size = Word64 + +-- | Find the pathname to a block device with a given device number. +-- +-- >>> devnoToDevname 0x0800 +-- Just "/dev/sda" +devnoToDevname :: CDev -> IO (Maybe String) +devnoToDevname d = bracket (devno_to_devname d) c_free (maybePeek peekCString) + +-- | Convert the @'CDev'@ device number to the /name/ of the whole +-- disk. The function DOES NOT return full device name. The @'CDev'@ +-- argument could be partition or whole disk -- both are converted. +-- +-- For example: sda1, 0x0801 --> sda, 0x0800 +-- +-- >>> devnoToWholedisk 0x0801 +-- ("sda",2048) +devnoToWholedisk :: CDev -> IO (String, CDev) +devnoToWholedisk d = + allocaBytes 32 $ \pc -> + alloca $ \pd -> + do throwIfNeg_ (\e -> "blkid_devno_to_wholedisk returned " ++ show e) (devno_to_wholedisk d pc 32 pd) + str <- peekCString pc + d1 <- peek pd + return (str, d1) + +-- | Send an event @'String'@ for a device. +sendUevent :: FilePath -> String -> IO () +sendUevent path str = + withCString path $ \p -> + withCString str $ \s -> + throwIfNeg_ (\e -> "blkid_send_uevent returned " ++ show e) (send_uevent p s) + +-- | Get the size of a device given its file descriptor. +getDevSize :: Fd -> IO Size +getDevSize (Fd n) = get_dev_size n >>= return . fromIntegral + + +-- | @libblkid@ version. +libraryVersion :: String +libraryVersion = #{const_str BLKID_VERSION} + +-- | @libblkid@ release date. +libraryReleaseDate :: String +libraryReleaseDate = #{const_str BLKID_DATE} + +foreign import ccall "blkid_devno_to_devname" devno_to_devname :: CDev + -> IO CString + +foreign import ccall "blkid_devno_to_wholedisk" devno_to_wholedisk :: CDev + -> CString + -> CSize + -> Ptr CDev + -> IO CInt + + +foreign import ccall "blkid_get_dev_size" get_dev_size :: CInt -> IO BlkidLoff + +foreign import ccall "blkid_send_uevent" + send_uevent :: CString -> CString -> IO CInt diff --git a/linux-blkid.cabal b/linux-blkid.cabal new file mode 100644 --- /dev/null +++ b/linux-blkid.cabal @@ -0,0 +1,26 @@ +Name: linux-blkid +Version: 0.1.0.0 +Cabal-Version: >= 1.8 +Build-Type: Simple +License: LGPL-2.1 +License-File: LICENSE +Copyright: © 2013 Nicola Squartini +Author: Nicola Squartini +Maintainer: Nicola Squartini +Bug-Reports: mailto:tensor5@gmail.com +Category: System +Stability: experimental +Synopsis: Linux libblkid +Description: Bindings to the Linux libblkid library. + +Library + Build-Depends: base == 4.*, + transformers == 0.3.* +-- uuid == 1.2.* + Ghc-Options: -Wall + Exposed-modules: System.Linux.Blkid + System.Linux.Blkid.Cache + System.Linux.Blkid.Evaluate + System.Linux.Blkid.Probe + System.Linux.Blkid.Utils + Pkgconfig-Depends: blkid