hsshellscript (empty) → 3.1.0
raw patch · 21 files changed
+6543/−0 lines, 21 filesdep +basedep +directorydep +parsecsetup-changed
Dependencies added: base, directory, parsec, random, unix
Files
- LICENSE +504/−0
- Makefile +24/−0
- README +13/−0
- Setup.hs +2/−0
- hsshellscript.cabal +48/−0
- manual/LICENSE +504/−0
- manual/features.html +51/−0
- manual/imports.html +27/−0
- manual/index.html +28/−0
- manual/install.html +41/−0
- manual/requirements.html +38/−0
- manual/usage.html +26/−0
- src/HsShellScript.hs +302/−0
- src/HsShellScript/Args.hs +978/−0
- src/HsShellScript/Commands.chs +545/−0
- src/HsShellScript/GetOpt.hs +266/−0
- src/HsShellScript/Misc.chs +511/−0
- src/HsShellScript/Paths.hs +464/−0
- src/HsShellScript/ProcErr.chs +1949/−0
- src/HsShellScript/Shell.hs +86/−0
- src/cbits/hsshellscript.c +136/−0
+ LICENSE view
@@ -0,0 +1,504 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 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.++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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.++ <signature of Ty Coon>, 1 April 1990+ Ty Coon, President of Vice++That's all there is to it!++
+ Makefile view
@@ -0,0 +1,24 @@+CFLAGS = -XScopedTypeVariables++default :: lib++lib ::+ cabal configure+ cabal build+ cabal haddock+ cabal install++dist/build/libHShsshellscript-3.0.0.a :: + cabal build++dist ::+ cabal sdist++install-manual ::+ mkdir -p /usr/local/share/hsshellscript/manual+ cp -rv manual/* /usr/local/share/hsshellscript/manual+ rm -f /usr/local/share/hsshellscript/manual/*~++uninstall-manual ::+ rm -rf /usr/local/share/hsshellscript/manual+ rmdir --ignore-fail-on-non-empty /usr/local/share/hsshellscript
+ README view
@@ -0,0 +1,13 @@+This is HsShellScript, a library which enables you to use Haskell for tasks which+are typically done by shell scripts. It requires the Glasgow Haskell Compiler.++The installation instructions are in the user manual. It is located in the "manual"+subdirectory. ++HsShellScript is released under the terms of the GNU Lesser General Public License+(LGPL), version 2.1, or any later version. A copy of the license in included in+the user manual.++The homepage is at http://www.volker-wysk.de/hsshellscript.++Volker Wysk <hsss@volker-wysk.de>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsshellscript.cabal view
@@ -0,0 +1,48 @@+Name: hsshellscript+Version: 3.1.0+Synopsis: Haskell for Unix shell scripting tasks+Description: A Haskell-library for tasks which are usually done in+ shell scripts. This includes parsing command line+ arguments; dealing with paths; some commands for dealing+ with files; calling external programs and subroutines as+ separate processes; pipes and redirection of input and+ output; and error handling.+Homepage: http://www.volker-wysk.de/hsshellscript/+License: LGPL+License-file: LICENSE+Author: Volker Wysk+Maintainer: hsss@volker-wysk.de+Copyright: (c)2004-2011 by Volker Wysk+Category: System+Build-type: Simple+Extra-source-files: README, manual/*.html, manual/LICENSE, Makefile++cabal-version: >= 1.6+++Library+ Exposed-Modules: HsShellScript,+ HsShellScript.Args+ HsShellScript.Commands+ HsShellScript.GetOpt+ HsShellScript.Misc+ HsShellScript.Paths+ HsShellScript.ProcErr+ HsShellScript.Shell+ Extensions: DeriveDataTypeable,+ ForeignFunctionInterface,+ RecordWildCards,+ ScopedTypeVariables,+ NamedFieldPuns+ Build-depends: base >= 3 && < 6,+ unix >= 2.3.2,+ directory,+ parsec >= 2.1.0.1,+ random+ hs-source-dirs: src+ C-Sources: src/cbits/hsshellscript.c++ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ Build-tools: c2hs >= 0.15.1++
+ manual/LICENSE view
@@ -0,0 +1,504 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 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.++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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.++ <signature of Ty Coon>, 1 April 1990+ Ty Coon, President of Vice++That's all there is to it!++
+ manual/features.html view
@@ -0,0 +1,51 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE></TITLE>+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 1.1.0 (Linux)">+ <META NAME="CREATED" CONTENT="20040206;20494700">+ <META NAME="CHANGED" CONTENT="20040206;21432900">+</HEAD>+<BODY LANG="en-US" DIR="LTR">+<H2>HsShellScript Features</H2>++<h3>Command Line Argument Parser</h3><p>+ HsShellScript has facilities for managing command line arguments, which are+ easier to use than the GHC library GetOpt. Command line+ arguments are specified as lists of properties. HsShellScript builds on top+ of GHC's GetOpt, but hides it completely. Command line arguments handling+ has been added because GetOpt was found to be too cumbersome.</p>+<h3>Easy Interface to External Programs</h3><p>+ Calling programs and recognizing errors (via exitcode or exception) is made more easy. There are front end functions for common programs, such as+ <tt>/bin/mv</tt> or <tt>/bin/chmod</tt>. </p>+<h3>Analyzing Paths</h3><p>+ Dealing with paths is not as trivial as it sounds. Take, for example+ <tt>../foo.bar//./../baz/</tt> (and split off the extension of the file+ name...). HsShellScript solves this thoroughly and provides functions for such+ tasks as splitting a path in directory and file name parts, splitting a path+ into path components, or syntactically normalising paths.</p>+<h3>Redirecting Input and Output</h3><p>+ HsShellScript defines operators like <tt>->-</tt> and <tt>->>-</tt> which work like+ redirection operators in shells.</p>+<h3>Building Pipes</h3><p>+ Reading the output of an external program, or piping the output of one+ program into the input of another, is almost as easy as in shells.+ HsShellScript provides corresponding operators.</p>+<h3>Error Handling</h3><p>+ Error handling is one thing which is done more thoroughly in+ HsShellScript than in shells. Failed programs won't be silently ignored.+ Exceptions are used for error handling. Non zero exit codes+ are thrown as exceptions.</p>+<h3>Quoting of Strings and Building Commands for Shells</h3><p>+ Taking care of shell metacharacters usually isn't done right. HsShellScript+ provides functions for doing it safely.</p>+<h3>Non-broken, Secure Functions for Creating Temporary Files and Directories</h3><p>+ The standard C library has <tt>mkstemp</tt>, <tt>mktemp</tt>, <tt>tempnam</tt>, <tt>tmpfile</tt> and <tt>tmpnam</tt>, which are all broken,+ non-portable or unsuitable in some way.</p>+</dl>++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left: none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm; padding-left: 0cm; padding-right: 0cm">+<small><a href="index.html">HsShellScript User Manual main page</a></small></P>+</BODY>+</HTML>
+ manual/imports.html view
@@ -0,0 +1,27 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE></TITLE>+</HEAD>+<BODY LANG="en-US" DIR="LTR">+<H1>GHC-Libraries needed for HsShellScript</H1>++<p>In order to use HsShellScript's exception handling, you'll have to import+some and restrict some GHC-libraries (all of which are included in GHC). The+following source code will to the trick:+++<br><code>+<br>import Prelude hiding (catch)+<br>import IO hiding (catch)+<br>import Control.Exception+<br>import HsShellScript+</code>+++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left: none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm; padding-left: 0cm; padding-right: 0cm">+<small><a href="index.html">HsShellScript User Manual main page</a></small></P>++</BODY>+</HTML>
+ manual/index.html view
@@ -0,0 +1,28 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE>HsShellScript User Manual</TITLE>+</HEAD>+<BODY LANG="en-US" DIR="LTR">+<H1>HsShellScript User Manual</H1>++<P>This is the user manual for the <A HREF="http://www.volker-wysk.de/hsshellscript">HsShellScript</A>+Haskell shell scripting library, version 3.1.0. It has been released 2012-04-02. The API+documentation is in a separate document.</P>+<P>HsShellScript is a library which makes things easy to program in+Haskell, which are typically done by shell scripts on Unix-like+systems. You can use Haskell for writing your shell scripts.</P>+<p>Of course your Haskell scripts can grow to become real programs. It's all ready.++<P><A HREF="features.html">Features</A>+<BR><A HREF="requirements.html">Requirements</A>+<BR><A HREF="install.html">Installation</A>+<BR><A HREF="usage.html">Usage</A>+<BR><A HREF="imports.html">Necessary <tt>import</tt> declarations</A>+<BR><A HREF="LICENSE">License</A></P>++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left: none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm; padding-left: 0cm; padding-right: 0cm">+<small>Last changed 2012-04-02</small></P>+</BODY>+</HTML>
+ manual/install.html view
@@ -0,0 +1,41 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE></TITLE>+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 1.1.0 (Linux)">+ <META NAME="CREATED" CONTENT="20040204;11123200">+ <META NAME="CHANGED" CONTENT="20040921;23052000">+</HEAD>+<BODY LANG="de-DE" DIR="LTR">+<H2>Building and Installing HsShellScript</H2>++<p>HsShellScript is cabalized, which means that building and installing is a+ matter of some calls to <tt>cabal</tt>. However, it also provides a+ Makefile, which further simplifies the installation.++<p>In order to install, unpack the source distribution somewhere. Go to the+ directory, and call <tt>make</tt>. This will compile and install the library,+ locally, as a user package. The location of the API documentation+ is <tt>~/.cabal/share/doc/hsshellscript-3.1.0/html/index.html</tt>.++<p>Cabal's Simple Build Infrastructure doesn't provide any means to add extra+ documenation to a project. Therefore the user manual isn't installed by default.+ If you need it, you can just copy the "manual" directory anywhere you like,+ but the Makefile privides+ the make target <tt>install-manual</tt>, which copies the files to+ <tt>/usr/local/share/hsshellscript/manual</tt>.+ "<tt>make</tt>" must be run as root.+++<p>Further information about the Cabal can be found here:+<a href="http://www.haskell.org/cabal/">The Haskell Cabal</a>+++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left:+ none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm;+ padding-left: 0cm; padding-right:+ 0cm"><A HREF="index.html"><FONT SIZE=2>HsShellScript User Manual main+ page</FONT></A></P>+</BODY>+</HTML>
+ manual/requirements.html view
@@ -0,0 +1,38 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE></TITLE>+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 1.1.0 (Linux)">+ <META NAME="CREATED" CONTENT="20040206;21443400">+ <META NAME="CHANGED" CONTENT="20040206;22570100">+</HEAD>+<BODY LANG="en-US" DIR="LTR">++<H2>Requirements</H2>++<p><b>Requirements for using and for building</b>+<UL>+ <LI><P>The <A HREF="http://www.haskell.org/ghc/">Glasgow Haskell+ Compiler</A>. It works with GHC-7.4.1, and+ should also work with later versions. It might work with GHC-7.2, but does+ not work with GHC-7.0.4 or older.+ <LI><P>A Unix like system. HsShellScript is being developed and tested on Linux.</P>+</UL>++<p><b>Requirements only for building</b>+<UL>+ <LI><P>GNU make</P>+ <LI><P>The interface generator <A HREF="http://www.cse.unsw.edu.au/~chak/haskell/c2hs/">C2HS</A></P>+ <LI><P><A HREF="http://haskell.cs.yale.edu/haddock/">Haddock</A> for the API documentation</P>+</UL>+<p>GHC and Haddock are included in+ the <a href="http://hackage.haskell.org/platform/">The Haskell Platform</a>, + c2hs isn't.+++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left: none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm; padding-left: 0cm; padding-right: 0cm">+<small><a href="index.html">HsShellScript User Manual main page</a></small></P>++</BODY>+</HTML>
+ manual/usage.html view
@@ -0,0 +1,26 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HTML>+<HEAD>+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=iso-8859-1">+ <TITLE></TITLE>+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 1.1.0 (Linux)">+ <META NAME="CREATED" CONTENT="20040204;11373400">+ <META NAME="CHANGED" CONTENT="20040206;21553600">+ <STYLE>+ <!--+ @page { margin: 2cm }+ P { margin-bottom: 0.21cm }+ -->+ </STYLE>+</HEAD>+<BODY LANG="en-US" DIR="LTR">+<H2>Usage</H2>++<P>HsShellScript registers itself in GHC's package management system during installation. Therefore all you need is to add+"<code>-package hsshellscript</code>" to the command line when compiling and linking.</p>++<P STYLE="border-top: 1px solid #000000; border-bottom: none; border-left: none; border-right: none; padding-top: 0.05cm; padding-bottom: 0cm; padding-left: 0cm; padding-right: 0cm">+<small><a href="index.html">HsShellScript User Manual main page</a></small></P>++</body>+</html>
+ src/HsShellScript.hs view
@@ -0,0 +1,302 @@+-- HsShellScript main module+module HsShellScript (+ -- * Command Line Arguments+ -- Command line arguments are handled by the module "HsShellScript.Args", which is reexported by "HsShellScript".+ module HsShellScript.Args,++ -- * Paths and Directories+ mkdir, rmdir, pwd, cd, realpath, realpath_s, path_exists, path_exists', is_file, is_dir, with_wd,+ -- ** Parsing and Composing Paths+ module HsShellScript.Paths,++ -- * Symbolic Links+ is_symlink, symlink, readlink, readlink',++ -- * Manipulating Files+ rm, chmod, chown, cp, mv,+ HsShellScript.Commands.rename, rename_mv, force_rename, force_mv, force_rename_mv, force_cmd, force_writeable, force_writeable2,+ getFileStatus', fileAccess', setFileMode',++ -- * Interfaces to Some Specific External Commands+ mt_status, fdupes, du,++ -- * Calling External Programs++ -- ** Running a Subroutine in a Separate Process+ -- $subr++ -- ** About the @exec@ Functions+ -- $exec++ -- ** Functions for Forking Child Processes and Calling External Programs+ subproc,+ spawn,+ runprog, RunError(..), show_runerror, to_ioe, as_ioe,+ exec, execp, exece, execpe,+ echo, silently,+ system_runprog, system_throw, execute_file,+ child,+ explain_processstatus,+ call, run,++ -- * Redirecting Input and Output+ (->-), (->>-), (=>-), (=>>-), (-<-),+ (-&>-), (-&>>-),+ err_to_out, out_to_err,++ -- * Pipes++ -- ** File Descriptors in Pipes+ -- $fdpipes++ -- ** Pipe Creation Functions+ (-|-), (=|-), (-|=), (=|=),+ redirect,+ pipe_to, h_pipe_to,+ pipe_from, lazy_pipe_from, h_pipe_from,+ pipe_from2, lazy_pipe_from2, h_pipe_from2,+ pipes,++ -- * Shell-like Quoting+ module HsShellScript.Shell,++ -- * Creating temporary files and directories+ tmp_file, tmp_dir, temp_file, temp_dir, temp_path, with_tmp_file, with_tmp_dir, with_temp_file, with_temp_dir,++ -- * Reading mount information+ Mntent(..), read_mounts, read_mtab, read_fstab,++ -- * Output to the standard stream, colorful logging and error reporting+ outm, outm_, logm, logm_, errm, errm_,+ isatty,++ -- * Miscellaneous+ zeros, chomp, lazy_contents, contents, glob,++ -- * Error Handling+ mainwrapper, errno,+ strerror,+ perror',+ perror,+ {-abort, _exit,-}+ HsShellScript.ProcErr.failIO,+ exitcode,+ throwErrno',+ show_ioerror,+ fill_in_filename, fill_in_location, add_location+ )+where++-- import IO+-- import List+-- import Maybe+-- import Monad+-- import Random+-- import System+import Control.Exception+import GHC.IO+import HsShellScript.Args+import HsShellScript.Commands+import HsShellScript.Misc+import HsShellScript.Paths+import HsShellScript.ProcErr+import HsShellScript.Shell+import Prelude hiding (catch)+import System.Console.GetOpt+import System.Directory+import System.Exit+import System.Posix+++{- | Error reporting wrapper for the @main@ function. This catches any+ HsShellScript generated exceptions, and @IOError@s, prints+ an error message and exits with @exitFailure@. The @main@ function+ typically looks like this:++ >main = mainwrapper $ do ...++ The exceptions caught are 'ArgError', 'RunError', 'ProcessStatus' and @IOError@.+-}+mainwrapper :: IO a -- ^ Should be @main@+ -> IO a -- ^ Wrapped @main@+mainwrapper io =+ io+ `catches` [ Handler $ \(argerror :: ArgError) ->+ do errm (argerror_message argerror)+ putStrLn $ "\n" ++ (argerror_usageinfo argerror)+ exitFailure+ , Handler $ \(processstatus :: ProcessStatus) ->+ do errm $ "Process error. process status = " ++ show ( processstatus :: ProcessStatus )+ exitFailure+ , Handler $ \(runerror :: RunError) ->+ do errm (show_runerror runerror)+ exitFailure+ , Handler $ \(ioe :: IOError) ->+ do errm (show_ioerror ioe)+ exitFailure+ ]++{- $fdpipes+ #fdpipes#++ With HsShellScript, you build pipes from IO actions, which can replace+ themselves with an external program via a variant of @exec@. It's mostly+ transparent whether some part of the pipe is a subroutine of the main+ program, or an external program.++ But actually, there are two cases. When the forked process is a subroutine,+ the child's @stdin@ handle is connected to the parent. On the other hand,+ when the forked process consists of calling an @exec@ variant, that program's+ file descriptor 0 is to be connected to the parent process.++ Normally, @stdin@ connects exactly to file descriptor 0, but this isn't+ necessarily the case. For instance, when @stdin@ has been closed, the file+ descriptor will be reused on the next occasion. When it is reopened again+ by calling @GHC.Handle.hDuplicateTo h stdin@, then the new @stdin@+ will be using a different file descriptor, and file descriptor 0 will be in+ use by another handle. Thus, when forking a subroutine, we're connected via+ @stdin@, but we can't expect to be connected via file descriptor 0.++ In case the child process is to be replaced with another program, we need to+ make sure that right file descriptor connects to the parent process. This is+ accomplished by the @exec@ functions. They replace the standard file+ descriptors with the ones that the standard handles currently use. See+ "HsShellScript#exec" for details.++ These two examples work as expected.++ Example 1:++>-- This closes stdin.+>c <- contents "-"+>+>pipe_to something+> ( -- execp arranges for "something" to go to foo's file descriptor 0+> execp "foo" []+>+> -|- (do -- Read foo's standard output from new stdin handle+> c' <- lazy_contents "-"+> ...+> )+> )++ Example 2:++>-- Call wc to count the number of lines in txt+>count <- fmap (read . chomp) $+> pipe_from (putStr txt -|= execp "wc" ["-l"])++-}+++{- $subr+ #subr#++ It can by very useful to fork a child process, which executes a subroutine of+ the main program. In the following example, paths are piped to the @recode@+ program in order to convert them from ISO 8859-1 to UTF-8. Its output is read+ by a subroutine of the main program, which can use it to rename the files.++>main = mainwrapper $ do+> paths <- contents "-"+> pipe_to paths $+> ( execp "recode" ["-f", "latin1..utf8"]+> -|= (do paths_utf8 <- lazy_contents "-"+> mapM_ (\(path, path_utf8) ->+> ...+> )+> (zip (lines paths) (lines paths_utf8))+> )+> )++ The same could be achieved this way:++>main = mainwrapper $ do+> paths <- contents "-"+> paths_utf8 <-+> pipe_from ( putStr paths+> -|= execp "recode" ["-f", "latin1..utf8"]+> )+> mapM_ (\(path, path_utf8) ->+> ...+> )+> (zip (lines paths) (lines paths_utf8))++ Most of the time, it's intuitive. But sometimes, the forked subroutine+ interferes with the parent process.++ When the process clones itself by calling @fork(2)@, everything gets+ duplicated - open files, database connections, window system connections...+ This becomes an issue when the child process uses any of it. For instance,+ any buffered, not yet written data associated with a file handle gets+ duplicated. When the child process uses that handle, that data gets written+ twice.++ The functions which fork a child process ('call', 'spawn', 'silently',+ 'pipe_to' etc.) flush @stdout@ and @stderr@ (should be unbuffered) before the+ fork. So the child process can use them. The pipe functions also take care of+ @stdin@, which is used to read from the pipe. But they don't know about any+ other handles.++ What happens when the subroutine finishes? The control flow would escape into+ the main program, doing unexpected things. Therefore the functions which fork+ an IO action terminate the child process when the subroutine finishes. They+ do so by calling '_exit', circumventing normal program shutdown. Normal+ shutdown would flush cloned file handles, shut down database connections now+ shared with the parent process etc. Only the @stdout@ and @stderr@ are+ flushed before. If the child process requires any more cleanup on+ termination, such as flushing new file handles created in the child process,+ it's the responsibility of the programmer to do so before the subroutine+ exits.++ When the subroutine throws an exception, the control flow isn't allowed to+ escape into the main program either. Any exception is caught, an error+ message is printed, and the child process is terminated with @_exit 1@.++ The subroutine /must not/ terminate the child process normally, by calling+ @exitWith@ or @exitFailure@. It should terminate with '_exit'. Don't forget+ to flush @stdout@ before, which won't be line buffered when not connected to+ a terminal. It can also just leave the subroutine. The functions which fork+ child processes intercept any attempt of normal program shutdown in the child+ process (it's an @ExitException@, see the GHC library documentation). A+ warning message is printed, and the child is terminated with @_exit@, with+ the same exit code which it would have been.+-}+++{- $exec+ #exec#++ There are five @exec@ variants: 'exec', 'execp', 'exece', 'execpe' and+ 'execute_file'. The first four are frontends to @execute_file@. They+ differ in whether the @PATH@ is searched, and in whether a new environment is+ installed. The latter is a replacement for+ @System.Posix.Process.executeFile@. They are designed to work intuitively in+ conjunction with the functions which fork a child process, such as 'run',+ 'call', 'spawn', 'pipe_to' etc.++ Before replacing the process, @stdout@ and @stderr@ are flushed, so no yet+ unwritten data is lost. Then the file descriptors of the process are prepared+ for the exec, such that everything works as expected. The standard file+ descriptors 0-2 are made to correspond to the standard handles again (this+ might have changed, see "HsShellScript#exec"). They are also reset to+ blocking mode. All others are closed when the exec succeeds.++ /You can't use/ @executeFile@ /directly, unless you take care of the things+ outlined at/ "HsShellScript#exec" /and/ 'execute_file' /by yourself./++ If replacing the process fails (for instance, because the program wasn't+ found), then everything is restored to original state, and an @IOError@ is+ thrown, and the process continues with normal error handling. Normally, the+ @exec@ functions are used in conjunction with some of the functions which+ fork a child process. They also handle errors, so the forked action doesn't+ need to cope with failure of @exec@. The error handling and+ termination is done via the 'child' function.++ Sometimes you want to pass an open file descriptor to the program. In this+ case, you can't use the @exec@ variants. You need to call @executeFile@+ directly, and take care of the outlined matters by yourself. In this+ case, take a look at the source code of @execute_file@.++ For full details, see the documentation of 'execute_file'.+-}
+ src/HsShellScript/Args.hs view
@@ -0,0 +1,978 @@+-- |+-- This module provides a more convient way of parsing command line+-- arguments than the GHC GetOpt package. It makes use of GetOpt, but hides+-- it from the user. It is reexported from module HsShellScript.+--+-- For each command line argument, a description is to be created with+-- @argdesc@. Then the command line arguments are evaluated with+-- one of the @getargs@... functions. In case of an error, this will cause a+-- exception, which provides an expressive error message to be+-- printed. Then the @arg@... functions are used to extract the+-- values contained in the arguments, with the right type. The typical use+-- of HsShellScript.Args looks something like this:+--+-- >import HsShellScript+-- >+-- >main =+-- > do let a_onevalue = argdesc [ desc_at_most_once, ... ]+-- > a_values = argdesc [ desc_direct, ... ]+-- > a_switch = argdesc [ ... ]+-- > ...+-- > header = "mclapep - My Command Line Argument Parser Example Program, version 1.0.0"+-- >+-- > args <- getargs header [a_onevalue, a_values, a_switch, ...]+-- >+-- > val <- optarg_req a_onevalue args -- val :: Maybe String+-- > vals <- args_req a_values args -- vals :: [String]+-- > doit <- arg_switch a_switch args -- doit :: Bool+-- > ...+-- > `catch` +-- > (\argerror -> do+-- > hPutStrLn stderr $ (argerror_message argerror) ++ "\n\n" ++ (argerror_usageinfo argerror)+-- > exitFailure+-- > )+--+-- Errors in the argument descriptions are regarded as bugs, and handled+-- by aborting the program with a message which is meaningful to the+-- programmer. It is assumed that the argument description is a constant for+-- a given program.+--+-- Errors in the arguments are reported using HsShellScript's error handling+-- scheme. An error description+-- value is generated, and either returned via an @Either@+-- value, or thrown as an exception.++module HsShellScript.Args ( -- ** Argument Properties+ ArgumentProperty+ , ArgumentDescription (..)+ , ArgumentValueSpec (..)+ , Argtester+ , argdesc+ , desc_short+ , desc_long+ , desc_direct+ , desc_value_required+ , desc_value_optional+ , desc_times+ , desc_once+ , desc_at_least_once+ , desc_at_most_once+ , desc_any_times+ , desc_at_least+ , desc_at_most+ , desc_argname+ , desc_description+ , desc_tester+ , desc_integer+ , desc_nonneg_integer+ , readtester+ -- ** Evaluating the Command Line+ , Arguments+ , getargs+ , getargs_ordered+ , getargs'+ , getargs_ordered'+ , unsafe_getargs+ , unsafe_getargs_ordered+ -- ** Extracting the Argument Values+ , arg_switch+ , arg_times+ , args_opt+ , args_req+ , reqarg_opt+ , reqarg_req+ , optarg_opt+ , optarg_req+ , arg_occurs+ -- ** Placing additional Constraints on the Arguments+ , args_none+ , args_all+ , args_one+ , args_at_most_one+ , args_at_least_one+ , arg_conflicts+ -- ** Argument Error Reporting+ , ArgError (..)+ , usage_info+ , argname+ , argname_a+ ) where++-- We use a fixed copy of GHC's GetOpt implementation. This is to work around a bug.+-- import System.Console.GetOpt+import HsShellScript.GetOpt++import Control.Monad+import Control.Exception+import Prelude hiding (catch)+import Data.Maybe+import System.Environment+import Data.List+import GHC.IO+import System.IO+import HsShellScript.Shell+import Data.Char+import Debug.Trace+import Data.Typeable+++++-- | Does the command line argument take an value?+data ArgumentValueSpec = ArgumentValue_none -- ^ No value+ | ArgumentValue_required -- ^ Value required+ | ArgumentValue_optional -- ^ Value optional+ deriving (Eq, Show, Ord)+++-- | Argument value tester function. This tests the format of an argument's value for errors. The tester function is specified by+-- 'desc_tester' or such, as part of the argument description. +-- +-- The tester is passed the argument value. If the format is correct, then it returns @Nothing@. If there is an error, then it returns @Just msgf@,+-- with @msgf@ being an error message generation function. This function gets passed the argument description, and produces the error+-- message. The argument description typically is used to extract a descriptive name of the argument (using 'argname' or 'argname_a') to be included+-- in the error message.+type Argtester = String -- Argument value to be tested+ -> Maybe (ArgumentDescription -- Argument description for message generation+ -> String -- Error message+ )+++-- | Description of one command line argument. These are generated by+-- @argdesc@ from a list of argument properties, and subsequently used by one of the+-- @getargs@... functions. This type is abstract.+data ArgumentDescription = ArgumentDescription {+ argdesc_short_args :: [Char], -- ^ Short option names+ argdesc_long_args :: [String], -- ^ Long option names+ argdesc_argarg :: ArgumentValueSpec, -- ^ What about a possible value of the argument?+ argdesc_times :: Maybe (Int,Int), -- ^ Minimum and maximum of number of occurences allowed+ argdesc_argargname :: Maybe String, -- ^ Name for argument's value, for message generation+ argdesc_argarg_description :: Maybe String, -- ^ Descrition of the argument, for message generation+ argdesc_argarg_tester :: Maybe Argtester -- ^ Argument value tester+ }++-- excluding tester+ad_tup ad = + (argdesc_short_args ad, argdesc_long_args ad, argdesc_argarg ad, argdesc_times ad, argdesc_argargname ad, argdesc_argarg_description ad)++instance Eq ArgumentDescription where+ d == e = ad_tup d == ad_tup e++instance Ord ArgumentDescription where+ compare d e = compare (ad_tup d) (ad_tup e)++-- value for maximum number of times+unlimited = -1++-- Whether two argument descriptions describe the same argument.+-- Every short or long argument name occurs in only one argument+-- descriptor (this is checked). Every argument has a short or a long+-- name (short = [], long = [""] for direct arguments).+same_arg :: ArgumentDescription -> ArgumentDescription -> Bool+same_arg arg1 arg2 =+ case (argdesc_short_args arg1, argdesc_short_args arg2) of+ (a:_, b:_) -> a == b+ ([], []) -> case (argdesc_long_args arg1, argdesc_long_args arg2) of+ ([],_) -> unnamed+ (_,[]) -> unnamed+ (l1,l2) -> head l1 == head l2+ _ -> False+ where unnamed = error "Bug in argument description: nameless, non-direct argument. desc_short or desc_long must be specified."++-- | A property of a command line argument. These are generated by the+-- @desc_@... functions, and condensed to argument+-- descriptions of type @ArgumentDescription@ by @argdesc@. This type is abstract.+newtype ArgumentProperty =+ ArgumentProperty { argumentproperty :: ArgumentDescription -> ArgumentDescription }+-- An argument property is a function which fills in part of an argument descriptor.+++-- starting value for argument descriptor+nulldesc :: ArgumentDescription+nulldesc =+ ArgumentDescription {+ argdesc_short_args = [],+ argdesc_long_args = [],+ argdesc_argarg = ArgumentValue_none,+ argdesc_times = Nothing, -- default = (0,1)+ argdesc_argargname = Nothing,+ argdesc_argarg_description = Nothing,+ argdesc_argarg_tester = Nothing+ }++-- default number of times an argument may occur+times_default = (0,1)+++-- | This represents the parsed contents of the command line. It is returned+-- by the @getargs@... functions, and passed on to the+-- value extraction functions by the user.+--+-- See 'getargs', 'getargs_ordered', 'getargs\'', 'getargs_ordered\''.+newtype Arguments =+ Arguments ( [ ( ArgumentDescription -- argument descriptor+ , [Maybe String] -- arguments matching this descriptor+ )+ ]+ , String -- usage information+ )++argvalues :: Arguments -> ArgumentDescription -> [Maybe String]+argvalues (Arguments (l,_)) desc =+ argvalues' l+ where+ argvalues' ((d,v):r) = if same_arg desc d then v else argvalues' r+ argvalues' [] = abort "Bug using HsShellScript: Value of unknown argument queried (add it to getarg's list)" desc++-- used internally to represent one occurence of a specific argument+type ArgOcc = (ArgumentDescription, Maybe String)+++-- | Error thrown when there is an error in the+-- command line arguments.+data ArgError = ArgError {+ -- | Error message generated by HsShellScript.Args.+ argerror_message :: String,+ -- | Usage information derived from the argument descriptions.+ argerror_usageinfo :: String+ }+ deriving (Typeable)+++-- |+-- Make @ArgError@ an instance of @Exception@, so we can throw and catch it, using GHC-6.10\'s new exception library.+instance Exception ArgError+++---+-- Printing an @ArgError@ will produce the error message. The usage+-- information must be printed separately, using @usage_info@.+instance Show ArgError where+ show argerror = argerror_message argerror+++-- Whether it is the description for direct arguments. Direct arguments are+-- the ones without introducing "-" or "--".+is_direct :: ArgumentDescription -> Bool+is_direct desc =+ argdesc_short_args desc == [] && argdesc_long_args desc == [""]+++-- |+-- Short name of the argument. This specifies a character for a+-- one letter style argument, like @-x@. There can be specified+-- several for the same argument. Each argument needs at least+-- either a short or a long name.+desc_short :: Char -- ^ The character to name the argument.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_short c = ArgumentProperty+ (\desc ->+ if (c `elem` (argdesc_short_args desc))+ then abort ("Bug in HsShellScript argument description: Duplicate short argument " ++ show c ++ " specified") desc+ else if ("" `elem` argdesc_long_args desc)+ then abort_conflict "" desc+ else desc { argdesc_short_args = c : argdesc_short_args desc }+ )++-- |+-- Long name of the argument. This specifies a GNU style long+-- name for the argument, like @--arg@ or @--arg=...@. There can be specified+-- several names for the same argument. Each argument needs at least+-- either a short or a long name.+desc_long :: String -- ^ The long name of the argument.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_long str = ArgumentProperty+ (\desc ->+ if (str `elem` (argdesc_long_args desc))+ then abort ("Bug in HsShellScript argument description: Duplicate long argument " ++ show str ++ " specified") desc+ else if ("" `elem` argdesc_long_args desc)+ then abort_conflict "" desc+ else desc { argdesc_long_args = str : argdesc_long_args desc }+ )++-- |+-- Signal that this is the description of direct arguments. Direct arguments+-- are the ones not introduced by any short or long argument names (like+-- @-x@ or @--arg@), or which occur after the special+-- argument @--@. The presence of @desc_direct@ in the argument properties list+-- signals @argdesc@ that this is the description of the direct+-- arguments. There may be at most one such description.+desc_direct :: ArgumentProperty+desc_direct = ArgumentProperty+ (\desc ->+ if argdesc_long_args desc == [] && argdesc_short_args desc == [] && argdesc_argarg desc == ArgumentValue_none+ then desc { argdesc_long_args = [""], argdesc_argarg = ArgumentValue_required, argdesc_argargname = Just "" }+ else abort_conflict "desc_direct conflicts desc_long, desc_short, desc_value_required and desc_value_optional." desc+ )++-- |+-- Signal that the argument requires a value.+desc_value_required :: ArgumentProperty+desc_value_required = ArgumentProperty+ (\desc ->+ if argdesc_argarg desc == ArgumentValue_none+ then desc { argdesc_argarg = ArgumentValue_required }+ else abort_conflict "desc_value_required repeated or conflicting desc_value_optional" desc+ )++-- |+-- Signal that the argument optionally has a value. The user may or may+-- not specify a value to this argument.+desc_value_optional :: ArgumentProperty+desc_value_optional = ArgumentProperty+ (\desc ->+ if argdesc_argarg desc == ArgumentValue_none+ then desc { argdesc_argarg = ArgumentValue_optional }+ else abort_conflict "desc_value_optional repeated or conflicting desc_value_required" desc+ )++-- |+-- Specify lower and upper bound on the number of times an argument may+-- occur.+desc_times :: Int -- ^ Lower bound of the allowed number of argdesc_times.+ -> Int -- ^ Upper bound of the allowed number of argdesc_times.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_times n m = ArgumentProperty+ (\desc ->+ if argdesc_times desc == Nothing+ then desc { argdesc_times = Just (n,m) }+ else abort_conflict "desc_times conflicting previous number of occurences specification" desc+ )++-- |+-- Signal that the argument must be present exactly once. This is+-- meaningful only for arguments which can take a value.+desc_once :: ArgumentProperty -- ^ The corresponding argument property.+desc_once = desc_times 1 1++-- |+-- Signal that the argument must occur at least one time.+desc_at_least_once :: ArgumentProperty -- ^ The corresponding argument property.+desc_at_least_once = desc_times 1 unlimited++-- |+-- Signal that the argument must occur at most one time.+desc_at_most_once :: ArgumentProperty -- ^ The corresponding argument property.+desc_at_most_once = desc_times 0 1++-- |+-- Signal that the argument must have at least the specified number of+-- occurences, and has no upper limit of occurences.+desc_at_least :: Int -- ^ Number of times.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_at_least n = desc_times n unlimited++-- |+-- Signal that the argument may occur any number of times.+desc_any_times :: ArgumentProperty -- ^ The corresponding argument property.+desc_any_times = desc_times 0 unlimited++-- |+-- Signal that the argument does not need to be present, and may occur at most+-- the specified number of times.+desc_at_most :: Int -- ^ Number of times.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_at_most n = desc_times 0 n++-- |+-- Specify the descriptive name for command line argument's value. Used for the+-- generation of the usage message. The name should be very short.+desc_argname :: String -- ^ Name of the argument's value.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_argname name = ArgumentProperty+ (\desc ->+ if argdesc_argargname desc == Nothing+ then desc { argdesc_argargname = Just name }+ else abort "Bug in HsShellScript argument description: Multiple names specified" desc+ )++-- |+-- Specify a short description of what the argument does. Used for the+-- generation of the usage message. This is to fit on one line, after the+-- short and long argument names. It should be 40 characters long or so.+desc_description :: String -- ^ Short description of the argument.+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_description expl = ArgumentProperty+ (\desc ->+ if argdesc_argarg_description desc == Nothing+ then desc { argdesc_argarg_description = Just expl }+ else abort "Bug in HsShellScript argument description: Multiple explanations specified" desc+ )++-- | Specify a tester for this argument. The tester is a function which tests the argument value for format errors. Typically, it tests whether the+-- value can be parsed to some target type. If the test fails, the tester produces an error message. When parsing the command line arguments (which+-- @getargs@ or related), all the testers are applied to the respective argument values, and an 'ArgError' is thrown in case of failure. By using a+-- tester, it can be ensured that the argument values abide a specific format when extracting them, such that they can be parsed without errors, e.g.+-- @myarg = read (reqarg_req args d_myarg)@.+--+-- An argument tester is a function of type 'Argtester'. +--+-- See 'readtester', 'desc_integer', 'desc_nonneg_integer', 'Argtester'.+desc_tester :: Argtester -- ^ Argument tester to apply to this argument+ -> ArgumentProperty -- ^ The corresponding argument property.+desc_tester t = ArgumentProperty+ (\desc ->+ case argdesc_argarg_tester desc of+ Nothing -> desc { argdesc_argarg_tester = Just t }+ Just _ -> abort "Bug in HsShellScript argument description: Multiple argument value testers specified" desc+ )+++-- |+-- Build an argument tester from a @reads@ like function. Typically, a specialisation of the standard prelude function @read@ is used. +-- Example: @readtester \"Integer expected.\" (reads :: ReadS Int)@+readtester :: ReadS a -- Reader function, like the standard prelude function @reads@+ -> String -- Additional message+ -> Argtester -- Argument tester to be passed to 'desc_tester'+readtester reader msg val = + case filter ((== "") . snd) $ reader val of+ [(_,"")] -> Nothing+ [] -> Just (\arg -> "Format error in the value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)+ _ -> Just (\arg -> "Ambigious value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)+++{- | Specify that the value of this argument, if present, is a positive integer. This will cause an error when the command line is parsed, and the+ argument's value doesn't specify an integer.++>desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")++ See 'desc_tester'.+-}+desc_integer :: ArgumentProperty+desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")+++{- | Specify that the value of this argument, if present, is a non-negative integer. This will cause an error when the command line is parsed, and the+ value doesn't specify a non-negative integer.++>desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )++ See 'desc_tester'.+-}+desc_nonneg_integer :: ArgumentProperty+desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )+++abort_conflict msg = abort ("Conflicting properties in argument description. " ++ msg)+abort msg desc = error (msg ++ "\nargument (so far): " ++ argname desc)++-- | Generate a descriptive argument name from an argument description, suitable for use in error messages. This uses the long and short argument names+-- (as specified by 'desc_short' and 'desc_long') and generates descriptive names of the argument like \"-f\", \"-myflag\", \"-f\/--myflag\", etc. All the+-- argument names are included. In case of direct arguments (see 'desc_direct'), the descriptive name is \"@(direct argument)@\".+argname :: ArgumentDescription -> String+argname desc =+ if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "(direct argument)"+ else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"+ else concat (intersperse "/" ( map (\s -> "-"++[s]) (argdesc_short_args desc) ++ map ("--" ++) (argdesc_long_args desc) ))++-- | Generate a descriptive argument name from an argument description, beginning with \"argument\". This uses the long and short argument names (as+-- specified by 'desc_short' and 'desc_long') and generates descriptive names of the argument like \"argument -f\", \"argument -myflag\", \"argument+-- -f\/--myflag\", etc. All the argument names are included. In case of direct arguments (see 'desc_direct'), the descriptive name is \"direct argument\".+argname_a :: ArgumentDescription -> String+argname_a desc =+ if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "direct argument"+ else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"+ else "argument " ++ concat (intersperse "/" ( map (\s -> "-"++[s]) (argdesc_short_args desc) ++ map ("--" ++) (argdesc_long_args desc) ))++up1 "" = ""+up1 (x:xs) = toUpper x : xs++-- complete generation of argument description+prop_final :: ArgumentProperty+prop_final = ArgumentProperty+ (\desc ->+ seq (if argdesc_argarg desc /= ArgumentValue_none && argdesc_argargname desc == Nothing+ then error $ "Bug in description of " ++ argname_a desc ++ ": Argument's value must be given a name using desc_argname."+ else if argdesc_argarg desc == ArgumentValue_none && argdesc_argargname desc /= Nothing+ then error $ "Bug in description of " ++ argname_a desc+ ++ ": Argument doesn't take a sub argument, but a name for it is specified."+ else ()+ ) $+ desc { argdesc_times = Just (fromMaybe times_default (argdesc_times desc))+ , argdesc_argarg_description = Just (fromMaybe "" (argdesc_argarg_description desc))+ }+ )++-- |+-- Make an argument description from a list of argument properties. This+-- condenses the list to an argument description,+-- which can be uses by the @getargs@... functions and the+-- argument value extraction functions.+argdesc :: [ArgumentProperty] -- ^ List of properties, which describe the command line argument.+ -> ArgumentDescription -- ^ The corresponding argument description.+argdesc propl =+ foldr (.) id (map argumentproperty (prop_final:propl)) nulldesc+++-- Parse command line arguments.+getargs0 :: String -> ArgOrder ArgOcc -> [String] -> [ArgumentDescription] -> Either ArgError Arguments+getargs0 header ordering cmdlargs descs =+ let ( descs_direct -- direct arguments (without argument name)+ , descs_regular -- regular arguments (with long or short argument name)+ ) = partition is_direct descs++ nonunique :: Eq a => [a] -> Maybe a+ nonunique (a:b:r) = if (a == b) then (Just a) else nonunique (b:r)+ nonunique _ = Nothing++ test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b+ test_unique extr what x =+ case nonunique (sort (concat (map extr descs))) of+ Just y -> error ("Bug: Several occurences of " ++ what ++ " " ++ show y ++ " in command line argument specifications")+ Nothing -> x++ optdescr = map make_optdescr descs_regular++ make_optdescr :: ArgumentDescription -> OptDescr ArgOcc+ make_optdescr desc =+ Option (argdesc_short_args desc)+ (argdesc_long_args desc)+ (case argdesc_argarg desc of+ ArgumentValue_none -> NoArg (desc, Nothing)+ ArgumentValue_required -> ReqArg (\arg -> (desc, Just arg))+ (fromJust (argdesc_argargname desc))+ ArgumentValue_optional -> OptArg (\arg -> (desc, arg))+ (fromJust (argdesc_argargname desc))+ )+ (fromJust (argdesc_argarg_description desc))++ -- Postprocessing after successful call to getOpt+ getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments+ getopt_post pars{-getOpt recognized arguments-} rest{-direct arguments-} =+ case (rest, descs_direct) of+ ([],[]) ->+ -- no direct arguments allowed and none provided+ getopt_post' pars+ (r, [d]) ->+ -- direct arguments allowed and expected+ getopt_post' (pars ++ zip (repeat d) (map Just r))+ ((x:xs), []) ->+ -- direct arguments provided, but not allowed+ Left (ArgError "Surplus arguments." usageinfo)+ _ ->+ -- several descriptions for direct arguments+ error "Bug in argument descriptions: Several descriptions for direct arguments (desc_direct) specified."++ add :: (ArgumentDescription, Maybe String) -> [(ArgumentDescription, [Maybe String])] -> [(ArgumentDescription, [Maybe String])]+ add (a,str) [] = [(a,[str])]+ add (b,str) ((a,l):r) =+ if same_arg a b then (a,str:l) : r+ else (a,l) : add (b,str) r++ getopt_post' :: [ArgOcc] -> Either ArgError Arguments+ getopt_post' pars{-all arguments-} =+ let pars' = foldr add (map (\d -> (d,[])) descs) pars++ -- Check the number of argument occurences+ check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError+ check_num [] = Nothing+ check_num ((desc,args):rest) =+ let (min,max) = fromJust (argdesc_times desc)+ number = length args+ wrong_number_msg =+ (if is_direct desc then fst else snd) $+ if number == 0 && min == 1 then+ ( "Missing argument."+ , "Missing " ++ argname_a desc ++ "."+ )+ else if number < min then+ ( "Too few arguments. " ++ show min ++ " required."+ , "Too few instances of " ++ argname_a desc ++ ". "++ show min ++ " required."+ )+ else if number > max && max == 1 then+ ( "Only one argument may be specified."+ , "Repeated " ++ argname_a desc ++ "."+ )+ else if number > max && max /= unlimited then+ ( "Too many arguments."+ , "Too many instances of " ++ argname_a desc ++ "."+ )+ else error "bug in HsShellScript.Args.hs"+ in if number >= min && (number <= max || max == unlimited)+ then check_num rest+ else Just (ArgError wrong_number_msg usageinfo)++ -- Apply any argument testers+ check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError+ check_testers [] = Nothing+ check_testers ((desc,args):rest) =+ case argdesc_argarg_tester desc of+ Just argdesc_argarg_tester -> + if argdesc_argarg desc == ArgumentValue_none + then abort "Bug in HsShellScript argument descriptions: Argument value tester specified,\n\+ \but no argument value has been allowed. Add desc_value_optional or\n\+ \desc_value_required." + desc+ else case filter isJust (map (argdesc_argarg_tester . fromJust) (filter isJust args)) of+ [] -> check_testers rest+ (Just msgf : _) -> Just (ArgError (msgf desc) usageinfo)+ Nothing -> check_testers rest++ in case check_testers pars' of + Nothing -> case check_num pars' of+ Nothing -> Right (Arguments (pars',usageinfo))+ Just err -> Left err+ Just err -> Left err++ -- usage information generated by GetOpt+ usageinfo = usageInfo header optdescr++ in test_unique argdesc_short_args "short argument" $+ test_unique argdesc_long_args "long argument" $+ case getOpt ordering optdescr cmdlargs of+ (pars, rest, []) ->+ getopt_post pars rest+ (_,_,f) ->+ throw (ArgError (unlines (map chomp f)) (usageInfo header optdescr))+ where+ -- duplicated here in order to break cyclic module dependency+ chomp "" = ""+ chomp "\n" = ""+ chomp [x] = [x]+ chomp (x:xs) = let xs' = chomp xs+ in if xs' == "" && x == '\n' then "" else x:xs'+++-- |+-- Parse command line arguments. The arguments are taken from a call to+-- @getArgs@ and parsed. Any error is thrown as a +-- @ArgError@ exception. The result is a value from which the+-- information in the command line can be extracted by the @arg@...,+-- @reqarg@... and @optarg@... functions.+--+-- Named arguments (like @-x@ or @--arg@) and direct+-- arguments may occur in any order.+getargs :: String -- ^ Header to be used in the usage info.+ -> [ArgumentDescription] -- ^ The argument descriptions.+ -> IO Arguments -- ^ The contents of the command line.+getargs header descs = do+ args <- getArgs+ let res = getargs0 header Permute args descs+ either throw+ return+ res++-- |+-- Parse command line arguments. The arguments are taken from a call to+-- @getArgs@ and parsed. Any error is thrown as a +-- @ArgError@ exception. The result is a value from which the+-- information in the command line can be extracted by the @arg@...,+-- @reqarg@... and @optarg@... functions.+--+-- All arguments after the first direct argument are regarded as direct+-- arguments. This means that argument names introduced by @-@+-- or @--@ no longer take effect.+getargs_ordered :: String -- ^ Header to be used in the usage info.+ -> [ArgumentDescription] -- ^ Descriptions of the arguments.+ -> IO Arguments -- ^ The contents of the command line.+getargs_ordered header descs = do+ args <- getArgs+ either throw+ return+ (getargs0 header RequireOrder args descs)++-- |+-- Parse the specified command line. Any error is returned as @Left+-- argerror@. In case of success, the result is returned as+-- @Right res@. From the result, the information in the command+-- line can be extracted by the @arg@..., @reqarg@...+-- and @optarg@... functions.+--+-- Named arguments (like @-x@ or @--arg@) and direct+-- arguments may occur in any order.+getargs' :: String -- ^ Header to be used in the usage info.+ -> [String] -- ^ Command line to be parsed.+ -> [ArgumentDescription] -- ^ The argument descriptions.+ -> Either ArgError Arguments -- ^ The contents of the command line.+getargs' header args descs = getargs0 header Permute args descs++-- |+-- Parse the specified command line. Any error is returned as @Left+-- argerror@. In case of success, the result is returned as+-- @Right res@. From the result, the information in the command+-- line can be extracted by the @arg@..., @reqarg@...+-- and @optarg@... functions.+--+-- All arguments after the first direct argument are regarded as direct+-- arguments. This means that argument names introduced by @-@+-- or @--@ no longer take effect.+getargs_ordered' :: String -- ^ Header to be used in the usage info.+ -> [String] -- ^ Command line to be parsed.+ -> [ArgumentDescription] -- ^ The argument descriptions.+ -> Either ArgError Arguments -- ^ The contents of the command line.+getargs_ordered' header args descs = getargs0 header RequireOrder args descs+++test_desc :: ArgumentDescription -> Bool -> String -> b -> b+test_desc desc ok msg x =+ if ok then x+ else abort msg desc++maybe_head :: [a] -> Maybe a+maybe_head [] = Nothing+maybe_head [a] = Just a++-- |+-- Query whether a certain switch is specified on the command line. A switch is an+-- argument which is allowed zero or one time, and has no value.+arg_switch :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Argument description of the switch.+ -> Bool -- ^ Whether the switch is present in the command line.+arg_switch args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_none && argdesc_times desc == Just (0,1))+ "bug: querying argument with is not a switch with arg_switch" $+ case argvalues args desc of+ [] -> False+ [Nothing] -> True++-- |+-- Query the number of occurences of an argument.+arg_times :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> Int -- ^ Number of times the argument occurs.+arg_times args desc =+ length (argvalues args desc)++-- |+-- Query the values of an argument with optional value. This is for+-- arguments which take an optional value, and may occur several times. The+-- occurences with value are represented as @Just value@, the occurences+-- without are represented as @Nothing@.+args_opt :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> [Maybe String] -- ^ The occurences of the argument.+args_opt args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_optional && snd (fromJust (argdesc_times desc)) /= 1)+ "Bug: Querying argument which doesn't take an optional value, or may not occur several times, with args_opt."+ $ argvalues args desc++-- |+-- Query the values of an argument with required value. This is for+-- arguments which require a value, and may occur several times.+args_req :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> [String] -- ^ The values of the argument.+args_req args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_required && snd (fromJust (argdesc_times desc)) /= 1)+ "Bug: Querying argument which doesn't require a value, or may not occur several times, with args_req." $+ map fromJust (argvalues args desc)++-- |+-- Query the optional value of a required argument. This is for arguments+-- which must occur once, and may have a value. If the argument is+-- specified, its value is returned as @Just value@. If it isn't, the result+-- is @Nothing@.+reqarg_opt :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> Maybe String -- ^ The value of the argument, if it occurs.+reqarg_opt args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_optional && argdesc_times desc == Just (1,1))+ "Bug: Querying argument which doesn't take an optional value, or which must not occur exactly once, with reqarg_opt." $+ head (argvalues args desc)++-- |+-- Query the value of a required argument. This is for arguments which must+-- occur exactly once, and require a value.+reqarg_req :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> String -- ^ The value of the argument.+reqarg_req args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_required && argdesc_times desc == Just (1,1))+ "Bug: Querying argument with non-required value, or which doesn't occur exactly once, with reqarg_req." $+ fromJust (head (argvalues args desc))++-- |+-- Query the optional value of an optional argument. This is for arguments+-- which may occur zero or one time, and which may or may not have a value.+-- If the argument doesn't occur, the result is @Nothing@. If it does occur,+-- but has no value, then the result is @Just Nothing@. If it does occur with+-- value, the result is @Just (Just value)@.+optarg_opt :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> Maybe (Maybe String) -- ^ The occurence of the argument and its value (see above).+optarg_opt args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_optional) "Bug: Querying argument with non-optional value with optarg_opt." $+ test_desc desc (fst (fromJust (argdesc_times desc)) == 0) "Bug: Querying argument which isn't optional with optarg_opt." $+ test_desc desc (snd (fromJust (argdesc_times desc)) == 1) "Bug: Querying argument which may occur several times optarg_opt." $+ maybe_head (argvalues args desc)++-- |+-- Query the value of an optional argument. This is for optional arguments+-- which require a value, and may occur at most once. The result is+-- @Just value@ if the argument occurs, and @Nothing@+-- if it doesn't occur.+optarg_req :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the argument.+ -> Maybe String -- ^ The value of the argument, if it occurs.+optarg_req args desc =+ test_desc desc (argdesc_argarg desc == ArgumentValue_required) "Bug: Querying argument with non-required value with optarg_req."+ $ test_desc desc (fst (fromJust (argdesc_times desc)) == 0) "Bug: Querying argument which isn't optional with optarg_req."+ $ test_desc desc (snd (fromJust (argdesc_times desc)) == 1) "Bug: Querying argument which may occur several times optarg_req."+ $ fmap fromJust (maybe_head (argvalues args desc))+++-- |+-- None of the specifed arguments may be present.+--+-- Throws an ArgError if any of the arguments are present.+args_none :: [ArgumentDescription] -- ^ List of the arguments which must not be present.+ -> Arguments -- ^ Command line parse result.+ -> IO ()+args_none descs args@(Arguments (argl,usageinfo)) =+ mapM_ (\desc ->+ when (arg_times args desc /= 0) $+ throw (ArgError (up1 (argname_a desc) ++ " is not allowed.\n") usageinfo)+ )+ descs++-- |+-- All of the specified arguments must be present.+--+-- Throws an ArgError if any is missing.+args_all :: [ArgumentDescription] -- ^ List of the arguments which must be present.+ -> Arguments -- ^ Command line parse result.+ -> IO ()+args_all descs args@(Arguments (argl,usageinfo)) =+ mapM_ (\desc ->+ when (arg_times args desc == 0) $+ throw (ArgError ("Missing " ++ argname_a desc ++ "\n") usageinfo)+ )+ descs++-- |+-- Exactly one of the specified arguments must be present.+--+-- Otherwise throw an ArgError.+args_one :: [ArgumentDescription] -- ^ List of the arguments, of which exactly one must be present.+ -> Arguments -- ^ Command line parse result.+ -> IO ()+args_one descs args@(Arguments (argl,usageinfo)) =+ when (occuring descs args /= 1) $+ throw (ArgError ("Exactly one of the following arguments must be present.\n"+ ++ concat (intersperse ", " (map argname descs)) ++ "\n")+ usageinfo)+++-- |+-- At most one of the specified arguments may be present.+--+-- Otherwise throw an ArgError.+args_at_most_one :: [ArgumentDescription] -- ^ List of the arguments, of which at most one may be present.+ -> Arguments -- ^ Command line parse result.+ -> IO ()+args_at_most_one descs args@(Arguments (argl,usageinfo)) =+ when (occuring descs args > 1) $+ throw (ArgError ("Only one of the following arguments may be present.\n"+ ++ concat (intersperse ", " (map argname descs)) ++ "\n")+ usageinfo)+++-- |+-- At least one of the specified arguments must be present.+--+-- Otherwise throw an ArgError.+args_at_least_one :: [ArgumentDescription] -- ^ List of the arguments, of which at least one must be present.+ -> Arguments -- ^ Command line parse result.+ -> IO ()+args_at_least_one descs args@(Arguments (argl,usageinfo)) =+ when (occuring descs args == 0) $+ throw (ArgError ("One of the following arguments must be present.\n"+ ++ concat (intersperse ", " (map argname descs)) ++ "\n")+ usageinfo)+++-- |+-- When the specified argument is present, then none of the other arguments may be present.+--+-- Otherwise throw an ArgError.+arg_conflicts :: ArgumentDescription -- ^ Argument which doesn't tolerate the other arguments+ -> [ArgumentDescription] -- ^ Arguments which aren't tolerated by the specified argument+ -> Arguments -- ^ Command line parse result.+ -> IO ()+arg_conflicts desc descs args@(Arguments (argl,usageinfo)) =+ when (arg_occurs args desc && occuring descs args > 1) $+ throw (ArgError ("When " ++ argname desc ++ " is present, none of the following arguments may be present.\n"+ ++ concat (intersperse ", " (map argname descs)) ++ "\n")+ usageinfo)+++-- How many of the specified arguments do occur? Multiple occurences of the same argument count as one.+occuring :: [ArgumentDescription] -> Arguments -> Int+occuring descs args =+ sum (map (\desc -> if arg_times args desc == 0 then 0 else 1) descs)+++{- | Whether the specified argument occurs in the command line. +-}+arg_occurs :: Arguments -- ^ Command line parse result.+ -> ArgumentDescription -- ^ Description of the respective argument.+ -> Bool -- ^ Whether the specified argument occurs in the command line.+arg_occurs args desc =+ occuring [desc] args == 1+++-- |+-- Get the usage information from the parsed arguments. The usage info+-- contains the header specified to the corresponding @getargs...@+-- function, and descriptions of the command line arguments.+usage_info :: Arguments -> String+usage_info (Arguments (_,ui)) = ui+++{-+instance Show (OptDescr a) where+ show (Option short long argdescr expl) =+ "Option short:" ++ showList short " long:" ++ show long ++ " argdescr:" ++ show argdescr ++ " expl:" ++ showList expl ""++instance Show (ArgDescr a) where+ show (NoArg _) = "NoArg"+ show (ReqArg _ _) = "ReqArg ..."+ show (OptArg _ _) = "OptArg ..."+-}+++{- | @getargs@ as a pure function, instead of an IO action. This allows to make evaluated command line arguments global values. This calls @getargs@+ to parse the command line arguments. @GHC.IO.unsafePerformIO@ is used to take the result out of the IO monad.++ >unsafe_getargs header descs = GHC.IO.unsafePerformIO $ getargs header descs++ The @getargs@ action is performed on demand, when the parse result is evaluated. It may result in an 'ArgError' being thrown. In order to avoid+ this happening at unexpected times, the @main@ function should, start with the line @seq args (return ())@, where @args@ is the result of+ @unsafe_getargs@,. This will trigger any command line argument errors at the beginning of the program. (See section 6.2 of the Hakell Report for the+ definition of @seq@).++ A typical use of @unsafe_getargs@ looks like this:++>header = "..."+>descs = [ d_myflag, ... ]+>+>d_myflag = argdesc [ ... ]+>+>args = unsafe_getargs header descs+>myflag = arg_switch args d_myflag+>+>main = mainwrapper $ do+> seq args (return ())+> ...++ See 'getargs', 'unsafe_getargs_ordered'.+-}+unsafe_getargs :: String -- ^ The header used in the usage information+ -> [ArgumentDescription] -- ^ The argument descriptions+ -> Arguments -- ^ The parsed command line arguments+unsafe_getargs header descs = + GHC.IO.unsafePerformIO $ getargs header descs+++{- | @getargs_ordered@ as a pure function, instead of an IO action. This is exactly like @unsafe_getargs@, but using @getargs_ordered@ instead of+ @getargs@.++ >unsafe_getargs_ordered = GHC.IO.unsafePerformIO $ getargs_ordered header descs++ See 'unsafe_getargs'.+-}+unsafe_getargs_ordered :: String -- ^ The header used in the usage information+ -> [ArgumentDescription] -- ^ The argument descriptions+ -> Arguments -- ^ The parsed command line arguments+unsafe_getargs_ordered header descs = + GHC.IO.unsafePerformIO $ getargs_ordered header descs
+ src/HsShellScript/Commands.chs view
@@ -0,0 +1,545 @@+-- #hide+module HsShellScript.Commands where+++import Prelude hiding (catch)+import Control.Exception+import Data.Bits+-- import Directory+import Foreign.C+import Foreign.C.Error+import Foreign.Ptr+import GHC.IO+import GHC.IO.Exception -- InvalidArgument, UnsupportedOperation+import HsShellScript.Misc+import HsShellScript.Misc+import HsShellScript.Paths+import HsShellScript.ProcErr+import HsShellScript.Shell+import System.IO.Error hiding (catch)+import Data.List+import Data.Maybe+import Control.Monad+import Text.ParserCombinators.Parsec as Parsec+import System.Posix hiding (rename, createDirectory, removeDirectory)+import System.Posix.Env+import System.Random+import System.Directory++-- |+-- Do a call to the @realpath(3)@ system library function. This makes the path absolute, normalizes it and expands all symbolic links. In case of an+-- error, an @IOError@ is thrown.+realpath :: String -- ^ path+ -> IO String -- ^ noramlized, absolute path, with symbolic links expanded+realpath path =+ withCString path $ \cpath -> do+ res <- {#call hsshellscript_get_realpath#} cpath+ if res == nullPtr+ then throwErrno' "realpath" Nothing (Just path)+ else peekCString res++-- | Determine the target of a symbolic link. This uses the @readlink(2)@ system call. The result is a path which is either absolute, or relative to+-- the directory which the symlink is in. In case of an error, an @IOError@ is thrown. The path is included and can be accessed with+-- @IO.ioeGetFileName@. Note that, if the path to the symlink ends with a slash, this path denotes the directory pointed to, /not/ the symlink. In+-- this case the call to will fail because of \"Invalid argument\".+readlink :: String -- ^ Path of the symbolic link+ -> IO String -- ^ The link target - where the symbolic link points to+readlink path =+ withCString path $ \cpath -> do+ res <- {#call hsshellscript_get_readlink#} cpath+ if res == nullPtr+ then throwErrno' "readlink" Nothing (Just path)+ else peekCString res++-- | Determine the target of a symbolic link. This uses the @readlink(2)@ system call. The target is converted, such that it is relative to the+-- current working directory, if it isn't absolute. Note that, if the path to the symlink ends with a slash, this path denotes the directory pointed+-- to, /not/ the symlink. In this case the call to @readlink@ will fail with an @IOError@ because of \"Invalid argument\". In case of any error, a+-- proper @IOError@ is thrown.+readlink' :: String -- ^ path of the symbolic link+ -> IO String -- ^ target; where the symbolic link points to+readlink' symlink = do+ target <- readlink symlink+ return (absolute_path' target (fst (split_path symlink)))+++-- | Determine whether a path is a symbolic link. The result for a dangling symlink is @True@. The path must exist in the file system. In case of an+-- error, a proper @IOError@ is thrown.+is_symlink :: String -- ^ path+ -> IO Bool -- ^ Whether the path is a symbolic link.+is_symlink path =+ do fill_in_location "is_symlink" $ readlink path+ return True+ `catch`+ (\(ioe::IOError) -> if (ioeGetErrorType ioe == InvalidArgument) then return False else ioError ioe)+++-- | Return the normalised, absolute version of a specified path. The path is made absolute with the current working directory, and is syntactically+-- normalised afterwards. This is the same as what the @realpath@ program reports with the @-s@ option. It's almost the same as what it reports when+-- called from a shell. The difference lies in the shell's idea of the current working directory. See 'cd' for details.+--+-- See 'cd', 'normalise_path'.+realpath_s :: String -- ^ path+ -> IO String -- ^ noramlized, absolute path, with symbolic links not expanded+realpath_s pfad =+ do cwd <- getCurrentDirectory+ return (normalise_path (absolute_path_by cwd pfad))+++-- |+-- Make a symbolic link. This is the @symlink(2)@ function. Any error results in an @IOError@ thrown. The path of the intended symlink is included in+-- the @IOError@ and+-- can be accessed with @ioeGetFileName@ from the Haskell standard library @IO@.+symlink :: String -- ^ contents of the symlink (/from/)+ -> String -- ^ path of the symlink (/to/)+ -> IO ()+symlink oldpath newpath = do+ o <- newCString oldpath+ n <- newCString newpath+ res <- {#call symlink as foreign_symlink#} o n+ when (res == -1) $ throwErrno' ("symlink " ++ shell_quote oldpath ++ " to " ++ shell_quote newpath) Nothing (Just newpath)+++-- |+-- Call the @du@ program. See du(1).+du :: (Integral int, Read int, Show int)+ => int -- ^ block size, this is the @--block-size@ option.+ -> String -- ^ path of the file or directory to determine the size of+ -> IO int -- ^ size in blocks+du block_gr pfad =+ let par = ["--summarize", "--block-size=" ++ show block_gr, pfad]+ parsen ausg =+ case reads ausg of+ [(groesse, _)] -> return groesse+ _ -> errm ("Can't parse the output of the \"du\" program: \n" ++ quote ausg ++ "\nShell command: " ++ shell_command "du" par)+ >> fail ("Parse error: " ++ ausg)+ in pipe_from (exec "/usr/bin/du" par) >>= parsen++++-- |+-- Create directory. This is a shorthand to @System.Directory.createDirectory@ from the Haskell standard+-- library. In case of an error, the path is included in the @IOError@, which GHC's implementation neglects to do.+mkdir :: String -- ^ path+ -> IO ()+mkdir path = + createDirectory path + `catch` (\(ioe::IOError) -> ioError (ioe { ioe_filename = Just path }))+++-- |+-- Remove directory. This is+-- @Directory.removeDirectory@ from the Haskell standard+-- library. In case of an error, the path is included in the @IOError@, which GHC's implementation neglects to do.+rmdir :: String -- ^ path+ -> IO ()+rmdir path = + removeDirectory path + `catch` (\(ioe::IOError) -> ioError (ioe { ioe_filename = Just path }))+++-- | Remove file. This is @Directory.removeFile@ from the Haskell standard library, which is a direct frontend to the @unlink(2)@ system call in GHC.+rm :: String -- ^ path+ -> IO ()+rm = removeFile+++{- | Change directory. This is an alias for @Directory.setCurrentDirectory@ from the Haskell standard+ library. In case of an error, the path is included in the @IOError@, which GHC's implementation neglects to do.++ Note that this command is subtly different from the shell's @cd@ command. It changes the process' working directory. This is always a realpath.+ Symlinks are expanded. The shell, on the other hand, keeps track of the current working directory separately, in a different way: symlinks are+ /not/ expanded. The shell's idea of the working directory is different from the working directory which a process has.++ This means that the same sequence of @cd@ commands, when done in a real shell script, will lead into the same directory. But the working directory+ as reported by the shell's @pwd@ command may differ from the corresponding one, reported by @getCurrentDirectory@.++ (When talking about the \"shell\", I'm talking about bash, regardless of whether started as @\/bin\/bash@ or in compatibility mode, as @\/bin\/sh@. I+ presume it's the standard behavior for the POSIX standard shell.)++ See 'pwd'.+-}+cd :: String -- ^ path+ -> IO ()+cd path = + setCurrentDirectory path + `catch` (\(ioe::IOError) -> ioError (ioe { ioe_filename = Just path }))+++-- |+-- Get program start working directory. This is the @PWD@ environent+-- variable, which is kept by the shell (bash, at least). It records the+-- directory path in which the program has been started. Symbolic links in+-- this path aren't expanded. In this way, it differs from+-- @getCurrentDirectory@ from the Haskell standard library.+pwd :: IO String+pwd = fmap (fromMaybe "") (System.Posix.Env.getEnv "PWD")+++{- | Execute @\/bin\/chmod@++>chmod = run "/bin/chmod"+-}+chmod :: [String] -- ^ Command line arguments+ -> IO ()+chmod = run "/bin/chmod"+++{- | Execute @\/bin\/chown@++>chown = run "/bin/chown"+-}+chown :: [String] -- ^ Command line arguments+ -> IO ()+chown = run "/bin/chown"+++-- |+-- Execute the cp program+cp :: String -- ^ source+ -> String -- ^ destination+ -> IO ()+cp from to =+ run "cp" [from, to]+++-- |+-- Execute the mv program+mv :: String -- ^ source+ -> String -- ^ destination+ -> IO ()+mv from to = run "mv" ["--", from, to]+++number :: Parser Int+number = do sgn <- ( (char '-' >> return (-1))+ <|> return 1+ )+ ds <- many1 digit+ return (sgn * read ds)+ <?> "number"++-- Parser for the output of the "mt status" command.+parse_mt_status :: Parser ( Int -- file number+ , Int -- block number+ )+parse_mt_status =+ do (fn,bn) <- parse_mt_status' (Nothing, Nothing)+ return (fromJust fn, fromJust bn)+ where+ try = Parsec.try++ parse_mt_status' :: (Maybe Int, Maybe Int) -> Parser (Maybe Int, Maybe Int)+ parse_mt_status' st = do+ st' <- parse_mt_status1' st+ ( parse_mt_status' st' <|> return st' )++ parse_mt_status1' :: (Maybe Int, Maybe Int) -> Parser (Maybe Int, Maybe Int)+ parse_mt_status1' st@(fn,bn) =+ try (do string "file number = "+ nr <- number+ newline+ return (Just nr, bn)+ )+ <|> try (do string "block number = "+ nr <- number+ newline+ return (fn, Just nr)+ )+ <|> (manyTill anyChar newline >> return st)++-- |+-- Run the command @mt status@ for querying the tape drive status, and+-- parse its output.+mt_status :: IO (Int, Int) -- ^ file and block number+mt_status = do+ out <- pipe_from (exec "/bin/mt" ["status"])+ case (parse parse_mt_status "" out) of+ Left err -> ioError (userError ("parse error at " ++ show err))+ Right x -> return x++++-- |+-- The @rename(2)@ system call to rename and\/or move a file. The @renameFile@ action from the Haskell standard library doesn\'t do it, because+-- the two paths may not refer to directories. Failure results in an @IOError@ thrown. The /new/ path is included in+-- the @IOError@ and+-- can be accessed with @IO.ioeGetFileName@.+rename :: String -- ^ Old path+ -> String -- ^ New path+ -> IO ()+rename oldpath newpath = do+ withCString oldpath $ \coldpath ->+ withCString newpath $ \cnewpath -> do+ res <- {#call rename as foreign_rename#} coldpath cnewpath+ when (res == -1) $ throwErrno' ("rename " ++ shell_quote oldpath ++ " to " ++ shell_quote newpath) Nothing (Just newpath)++++-- |+-- Rename a file. This first tries 'rename', which is most efficient. If it fails, because source and target path point to different file systems+-- (as indicated by the @errno@ value @EXDEV@), then @\/bin\/mv@ is called.+--+-- See 'rename', 'mv'.+rename_mv :: FilePath -- ^ Old path+ -> FilePath -- ^ New path+ -> IO ()+rename_mv old new =+ HsShellScript.Commands.rename old new+ `catch` (\(ioe::IOError) -> + if ioeGetErrorType ioe == UnsupportedOperation+ then do errno <- getErrno+ -- Foreign.C.Error.errnoToIOError matches many errno values to UnsupportedOperation. In order to determine+ -- if it is the right one, the errno is taken again. This relies on no system calls in between.+ if (errno == eXDEV)+ then run "/bin/mv" ["--", old, new]+ else ioError ioe+ else ioError ioe+ )+++{- | Rename a file or directory, and cope with read only issues.++This renames a file or directory, using @rename@, sets the necessary write permissions beforehand, and restores them afterwards. This is more+efficient than @force_mv@, because no external program needs to be called, but it can rename files only inside the same file system. See @force_cmd@+for a detailed description.++The new path may be an existing directory. In this case, it is assumed that the old file is to be moved into this directory (like with @mv@). The+new path is then completed with the file name component of the old path. You won't get an \"already exists\" error.++>force_rename = force_cmd rename++See 'force_cmd', 'rename'.+-}+force_rename :: String -- ^ Old path+ -> String -- ^ New path+ -> IO ()+force_rename = force_cmd HsShellScript.Commands.rename+++{- | Move a file or directory, and cope with read only issues.++This moves a file or directory, using the external command @mv@, sets the necessary write permissions beforehand, and restores them afterwards.+This is less efficient than @force_rename@, because the external program @mv@ needs to be called, but it can move files between file systems. See+@force_cmd@ for a detailed description.++>force_mv src tgt = fill_in_location "force_mv" $ force_cmd (\src tgt -> run "/bin/mv" ["--", src, tgt]) src tgt++See 'force_cmd', 'force_mv'.+-}+force_mv :: String -- ^ Old path+ -> String -- ^ New path or target directory+ -> IO ()+force_mv src tgt =+ fill_in_location "force_mv" $+ force_cmd (\src tgt -> run "/bin/mv" ["--", src, tgt]) src tgt+++{- | Rename a file with 'rename', or when necessary with 'mv', and cope with read only issues.++The necessary write permissions are set, then the file is renamed, then the permissions are restored.++First, the 'rename' system call is tried, which is most efficient. If it fails, because source and target path point to different file systems+(as indicated by the @errno@ value @EXDEV@), then @\/bin\/mv@ is called.++>force_rename_mv old new = fill_in_location "force_rename_mv" $ force_cmd rename_mv old new++See 'rename_mv', 'rename', 'mv', 'force_cmd'.+-}+force_rename_mv :: FilePath -- ^ Old path+ -> FilePath -- ^ New path+ -> IO ()+force_rename_mv old new =+ fill_in_location "force_rename_mv" $+ force_cmd rename_mv old new+++{- | Call a command which moves a file or directory, and cope with read only issues.++This function is for calling a command, which renames files. Beforehand, write permissions are set in order to enable the+operation, and afterwards the permissions are restored. The command is meant to be something like @rename@ or @run \"\/bin\/mv\"@.++In order to change the name of a file or dirctory, but leave it in the super directory+it is in, the super directory must be writeable. In order to move a file or directory to a different super directory, both super directories and+the file\/directory to be moved must be writeable. I don't know what this behaviour is supposed to be good for.++This function copes with the case that the file\/directory to be moved or renamed, or the super directories are read only. It makes the necessary+places writeable, calls the command, and makes them read only again, if they were before. The user needs the necessary permissions for changing the+corresponding write permissions. If an error occurs (such as file not found, or insufficient permissions), then the write permissions are restored+to the state before, before the exception is passed through to the caller.++The command must take two arguments, the old path and the new path. It is expected to create the new path in the file system, such that the correct+write permissions of the new path can be set by @force_cmd@ after executing it.++The new path may be an existing directory. In this case, it is assumed that the old file is to be moved into this directory (like with @mv@). The+new path is completed with the file name component of the old path, before it is passed to the command, such that the command is supplied the+complete new path.++Examples:++>force_cmd rename from to+>force_cmd (\from to -> run "/bin/mv" ["-i", "-v", "--", from, to]) from to++See 'force_rename', 'force_mv', 'rename'.+-}+force_cmd :: (String -> String -> IO ()) -- ^ Command to execute after preparing the permissions+ -> String -- ^ Old path+ -> String -- ^ New path or target directory+ -> IO ()+force_cmd cmd oldpath newpath0 =+ do isdir <- is_dir newpath0+ let newpath = if isdir then newpath0 ++ "/" ++ snd (split_path oldpath) else newpath0++ old_abs <- absolute_path oldpath+ new_abs <- absolute_path newpath+ let (olddir, _) = split_path old_abs+ (newdir, _) = split_path new_abs+ if olddir == newdir+ then -- Don't need to make the file/directory writeable.+ force_writeable olddir (cmd oldpath newpath)+ else -- Need to make both the file/dirctory and both super directories writeable.+ let cmd' = do res <- cmd oldpath newpath+ return (newpath, res)+ in force_writeable olddir (force_writeable newdir (force_writeable2 oldpath cmd'))+ `catch`+ (\(ioe::IOError) -> + ioError (if ioe_location ioe == "" || ioe_location ioe == "force_writeable" + then ioe { ioe_location = "force_cmd" } + else ioe))++++{- | Make a file or directory writeable for the user, perform an action, and restore its writeable status. An IOError is raised when the user doesn't+ have permission to make the file or directory writeable.++>force_writeable path io = force_writeable2 path (io >>= \res -> return (path, res))++Example:++>-- Need to create a new directory in /foo/bar, even if that's write protected+>force_writeable "/foo/bar" $ mkdir "/foo/bar/baz"++See 'force_cmd', 'force_writeable2'.+-}+force_writeable :: String -- ^ File or directory to make writeable+ -> IO a -- ^ Action to perform+ -> IO a -- ^ Returns the return value of the action+force_writeable path io =+ add_location "force_writeable" $+ force_writeable2 path (io >>= \res -> return (path, res))+++{- | Make a file or directory writeable for the user, perform an action, and restore its writeable status. The action may change the name of the file+ or directory. Therefore it returns the new name, along with another return value, which is passed to the caller.++ The writeable status is only changed back if it has been changed by @force_writeable2@ before. An IOError is raised when the user doesn'h have+ permission to make the file or directory writeable, or when the new path doesn't exist.++ See 'force_cmd', 'force_writeable'.+-}+force_writeable2 :: String -- ^ File or directory to make writeable+ -> IO (String, a) -- ^ Action to perform+ -> IO a+force_writeable2 path_before io =+ add_location "force_writeable2" $+ do writeable <- fileAccess' path_before False True False+ when (not writeable) $ set_user_writeable path_before+ (path_after, res) <-+ catch+ io+ (\(e::SomeException) -> + do when (not writeable) $+ catch (set_user_readonly path_before)+ ignore -- Don't let failure to restore the status make us loose the actual exception+ throwIO e+ )+ when (not writeable) $ set_user_readonly path_after+ return res++ where+ ignore :: SomeException -> IO ()+ ignore _ = return ()++ set_user_writeable path = do+ filemode <- fmap fileMode (getFileStatus' path)+ fill_in_filename path $ setFileMode' path (filemode .|. ownerWriteMode)++ set_user_readonly path = do+ filemode <- fmap fileMode (getFileStatus' path)+ fill_in_filename path $ setFileMode' path (filemode .&. (complement ownerWriteMode))+++-- |+-- Call the @fdupes@ program in order to find identical files. It outputs a+-- list of groups of file names, such that the files in each group are+-- identical. Each of these groups is further analysed by the @fdupes@+-- action. It is split to a list of lists of paths, such that each list+-- of paths corresponds to one of the directories which have been searched+-- by the @fdupes@ program. If you just want groups of identical files, then apply @map concat@ to the result.+--+-- /The/ @fdupes@ /program doesn\'t handle multiple occurences of the same directory, or in recursive mode one specified directory containing another,+-- properly. The same file may get reported multiple times, and identical files may not get reported./+--+-- The paths are normalised (using 'normalise_path').+fdupes :: [String] -- ^ Options for the fdupes program+ -> [String] -- ^ Directories with files to compare+ -> IO [[[String]]] -- ^ For each set of identical files, and each of the specified directories, the paths of the identical files in this+ -- directory.+fdupes opts paths = do+ let paths' = map normalise_path paths+ paths'' = map (++"/") paths'+ out <- fmap lines $ pipe_from (run "/usr/bin/fdupes" (opts ++ ["--"] ++ paths'))+ let grps = groups out+ return (map (sortgrp paths'') grps)+ where+ groups [] = []+ groups l =+ let l' = dropWhile (== "") l+ (g,rest) = span (/= "") l'+ in if g == [] then [] else (g : groups rest)++ split p [] = ([], [])+ split p (x:xs) =+ let (yes, no) = split p xs+ in if p x then (x:yes, no)+ else (yes, x:no)++ -- result: ( <paths within the directory>, <rest of paths> )+ path1 grp dir = split (isPrefixOf dir) grp++ -- super directories -> Group of identical files -> list of lists of files in each directory+ sortgrp dirs [] = map (const []) dirs+ sortgrp [] grp = error ("Bug: found paths which don't belong to any of the directories:\n" ++ show grp)+ sortgrp (dir:dirs) grp = let (paths1, grp_rest) = path1 grp dir+ in (paths1 : sortgrp dirs grp_rest)+++replace_location :: String+ -> String+ -> IO a+ -> IO a+replace_location was wodurch io =+ catch io+ (\(ioe::IOError) -> + if ioe_location ioe == was+ then ioError (ioe { ioe_location = wodurch })+ else ioError ioe+ )+++#c+/*+#include <string.h>+#include <stdlib.h>+#include <limits.h>+#include <unistd.h>+#include <stdio.h>+*/+int symlink(const char *oldpath, const char *newpath);+int rename(const char *oldpath, const char *newpath);++char* hsshellscript_get_realpath(char* path);+char* hsshellscript_get_readlink(char* path);+#endc+++
+ src/HsShellScript/GetOpt.hs view
@@ -0,0 +1,266 @@+-- #hide+{- This ist GetOpt from GHC 6.2.2. GHC 6.4's GetOpt is buggy - the "--" argument+ is no longer recognized. Therefore I include the old GetOpt here.+ HsShellScript.Args uses it.+-}++module HsShellScript.GetOpt (+ -- * GetOpt+ getOpt,+ usageInfo,+ ArgOrder(..),+ OptDescr(..),+ ArgDescr(..),++ -- * Example+ + -- $example+ ) where++import Prelude+import Data.List ( isPrefixOf )++-- |What to do with options following non-options+data ArgOrder a+ = RequireOrder -- ^ no option processing after first non-option+ | Permute -- ^ freely intersperse options and non-options+ | ReturnInOrder (String -> a) -- ^ wrap non-options into options++{-|+Each 'OptDescr' describes a single option.++The arguments to 'Option' are:++* list of short option characters++* list of long option strings (without \"--\")++* argument descriptor++* explanation of option for user+-}+data OptDescr a = -- description of a single options:+ Option [Char] -- list of short option characters+ [String] -- list of long option strings (without "--")+ (ArgDescr a) -- argument descriptor+ String -- explanation of option for user++-- |Describes whether an option takes an argument or not, and if so+-- how the argument is injected into a value of type @a@.+data ArgDescr a+ = NoArg a -- ^ no argument expected+ | ReqArg (String -> a) String -- ^ option requires argument+ | OptArg (Maybe String -> a) String -- ^ optional argument++data OptKind a -- kind of cmd line arg (internal use only):+ = Opt a -- an option+ | NonOpt String -- a non-option+ | EndOfOpts -- end-of-options marker (i.e. "--")+ | OptErr String -- something went wrong...++-- | Return a string describing the usage of a command, derived from+-- the header (first argument) and the options described by the +-- second argument.+usageInfo :: String -- header+ -> [OptDescr a] -- option descriptors+ -> String -- nicely formatted decription of options+usageInfo header optDescr = unlines (header:table)+ where (ss,ls,ds) = (unzip3 . map fmtOpt) optDescr+ table = zipWith3 paste (sameLen ss) (sameLen ls) ds+ paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z+ sameLen xs = flushLeft ((maximum . map length) xs) xs+ flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]++fmtOpt :: OptDescr a -> (String,String,String)+fmtOpt (Option sos los ad descr) = (sepBy ',' (map (fmtShort ad) sos),+ sepBy ',' (map (fmtLong ad) los),+ descr)+ where sepBy _ [] = ""+ sepBy _ [x] = x+ sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs++fmtShort :: ArgDescr a -> Char -> String+fmtShort (NoArg _ ) so = "-" ++ [so]+fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad+fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"++fmtLong :: ArgDescr a -> String -> String+fmtLong (NoArg _ ) lo = "--" ++ lo+fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad+fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"++{-|+Process the command-line, and return the list of values that matched+(and those that didn\'t). The arguments are:++* The order requirements (see 'ArgOrder')++* The option descriptions (see 'OptDescr')++* The actual command line arguments (presumably got from + 'System.Environment.getArgs').++'getOpt' returns a triple, consisting of the argument values, a list+of options that didn\'t match, and a list of error messages.+-}+getOpt :: ArgOrder a -- non-option handling+ -> [OptDescr a] -- option descriptors+ -> [String] -- the commandline arguments+ -> ([a],[String],[String]) -- (options,non-options,error messages)+getOpt _ _ [] = ([],[],[])+getOpt ordering optDescr (arg:args) = procNextOpt opt ordering+ where procNextOpt (Opt o) _ = (o:os,xs,es)+ procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[])+ procNextOpt (NonOpt x) Permute = (os,x:xs,es)+ procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,es)+ procNextOpt EndOfOpts RequireOrder = ([],rest,[])+ procNextOpt EndOfOpts Permute = ([],rest,[])+ procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[])+ procNextOpt (OptErr e) _ = (os,xs,e:es)++ (opt,rest) = getNext arg args optDescr+ (os,xs,es) = getOpt ordering optDescr rest++-- take a look at the next cmd line arg and decide what to do with it+getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])+getNext ('-':'-':[]) rest _ = (EndOfOpts,rest)+getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr+getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr+getNext a rest _ = (NonOpt a,rest)++-- handle long option+longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])+longOpt ls rs optDescr = long ads arg rs+ where (opt,arg) = break (=='=') ls+ getWith p = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `p` l ]+ exact = getWith (==)+ options = if null exact then getWith isPrefixOf else exact+ ads = [ ad | Option _ _ ad _ <- options ]+ optStr = ("--"++opt)++ long (_:_:_) _ rest = (errAmbig options optStr,rest)+ long [NoArg a ] [] rest = (Opt a,rest)+ long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest)+ long [ReqArg _ d] [] [] = (errReq d optStr,[])+ long [ReqArg f _] [] (r:rest) = (Opt (f r),rest)+ long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest)+ long [OptArg f _] [] rest = (Opt (f Nothing),rest)+ long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest)+ long _ _ rest = (errUnrec optStr,rest)++-- handle short option+shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])+shortOpt x xs rest optDescr = short ads xs rest+ where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ]+ ads = [ ad | Option _ _ ad _ <- options ]+ optStr = '-':[x]++ short (_:_:_) _ rest = (errAmbig options optStr,rest)+ short (NoArg a :_) [] rest = (Opt a,rest)+ short (NoArg a :_) xs rest = (Opt a,('-':xs):rest)+ short (ReqArg _ d:_) [] [] = (errReq d optStr,[])+ short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest)+ short (ReqArg f _:_) xs rest = (Opt (f xs),rest)+ short (OptArg f _:_) [] rest = (Opt (f Nothing),rest)+ short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest)+ short [] [] rest = (errUnrec optStr,rest)+ short [] xs rest = (errUnrec optStr,('-':xs):rest)++-- miscellaneous error formatting++errAmbig :: [OptDescr a] -> String -> OptKind a+errAmbig ods optStr = OptErr (usageInfo header ods)+ where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"++errReq :: String -> String -> OptKind a+errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")++errUnrec :: String -> OptKind a+errUnrec optStr = OptErr ("unrecognized option `" ++ optStr ++ "'\n")++errNoArg :: String -> OptKind a+errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")++{-+-----------------------------------------------------------------------------------------+-- and here a small and hopefully enlightening example:++data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show++options :: [OptDescr Flag]+options =+ [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files",+ Option ['V','?'] ["version","release"] (NoArg Version) "show version info",+ Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump",+ Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"]++out :: Maybe String -> Flag+out Nothing = Output "stdout"+out (Just o) = Output o++test :: ArgOrder Flag -> [String] -> String+test order cmdline = case getOpt order options cmdline of+ (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n"+ (_,_,errs) -> concat errs ++ usageInfo header options+ where header = "Usage: foobar [OPTION...] files..."++-- example runs:+-- putStr (test RequireOrder ["foo","-v"])+-- ==> options=[] args=["foo", "-v"]+-- putStr (test Permute ["foo","-v"])+-- ==> options=[Verbose] args=["foo"]+-- putStr (test (ReturnInOrder Arg) ["foo","-v"])+-- ==> options=[Arg "foo", Verbose] args=[]+-- putStr (test Permute ["foo","--","-v"])+-- ==> options=[] args=["foo", "-v"]+-- putStr (test Permute ["-?o","--name","bar","--na=baz"])+-- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[]+-- putStr (test Permute ["--ver","foo"])+-- ==> option `--ver' is ambiguous; could be one of:+-- -v --verbose verbosely list files+-- -V, -? --version, --release show version info +-- Usage: foobar [OPTION...] files...+-- -v --verbose verbosely list files +-- -V, -? --version, --release show version info +-- -o[FILE] --output[=FILE] use FILE for dump +-- -n USER --name=USER only dump USER's files+-----------------------------------------------------------------------------------------+-}++{- $example++To hopefully illuminate the role of the different data+structures, here\'s the command-line options for a (very simple)+compiler:++> module Opts where+> +> import System.Console.GetOpt+> import Data.Maybe ( fromMaybe )+> +> data Flag +> = Verbose | Version +> | Input String | Output String | LibDir String+> deriving Show+> +> options :: [OptDescr Flag]+> options =+> [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr"+> , Option ['V','?'] ["version"] (NoArg Version) "show version number"+> , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE"+> , Option ['c'] [] (OptArg inp "FILE") "input FILE"+> , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory"+> ]+> +> inp,outp :: Maybe String -> Flag+> outp = Output . fromMaybe "stdout"+> inp = Input . fromMaybe "stdout"+> +> compilerOpts :: [String] -> IO ([Flag], [String])+> compilerOpts argv = +> case (getOpt Permute options argv) of+> (o,n,[] ) -> return (o,n)+> (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+> where header = "Usage: ic [OPTION...] files..."++-}
+ src/HsShellScript/Misc.chs view
@@ -0,0 +1,511 @@+-- #hide+module HsShellScript.Misc where++import Control.Exception+import Control.Monad+import Data.Bits+import Data.Typeable+import Foreign+import Foreign.C+import Foreign.C.Error+import Foreign.C.String+import Foreign.Ptr+import GHC.IO hiding (finally, bracket)+import GHC.IO.Exception+import HsShellScript.ProcErr+import Prelude hiding (catch)+import System.Directory+import System.IO+import System.IO.Error hiding (catch)+import System.Posix hiding (removeDirectory)+import System.Random++++-- |+-- Format an @Int@ with leading zeros. If the string representation of the @Inŧ@ is longer than the number of characters to fill up, this produces as +-- many characters as needed.+zeros :: Int -- ^ How many characters to fill up+ -> Int -- ^ Value to represent as a string+ -> String -- ^ String representation of the value, using the specified number of characters+zeros stellen z =+ let txt = show z+ auff = stellen - length txt+ n = take (if auff >= 0 then auff else 0) (repeat '0')+ in n ++ txt+++-- |+-- Remove trailing newlines. This is silimar to perl's @chomp@ procedure.+chomp :: String -- ^ String to be chomped+ -> String -- ^ Same string, except for no newline characters at the end+chomp "" = ""+chomp "\n" = ""+chomp [x] = [x]+chomp (x:xs) = let xs' = chomp xs+ in if xs' == "" && x == '\n' then "" else x:xs'+++{- | Get contents of a file or of @stdin@. This is a simple frontend to+@hGetContents@. A file name of @\"-\"@ designates stdin. The contents are read+lazily as the string is evaluated.++(The handle which we read from will be in semi-closed state. Once all input+has read, it is closed automatically (Haskell Library Report 11.2.1).+Therefore we don't need to return it).++>lazy_contents path = do+> h <- if path == "-" then return stdin else openFile path ReadMode+> hGetContents h+-}+lazy_contents :: String -- ^ Either the name of a file, or @\"-\"@+ -> IO String -- ^ The lazily read contents of the file or @stdin@.+lazy_contents path = do+ h <- if path == "-" then return stdin else openFile path ReadMode+ hGetContents h++-- |+-- Get contents of a file or of @stdin@ eagerly. This is the+-- same as @lazy_contents@, except for the contents being+-- read immediately.+contents :: String -- ^ either the name of a file, or @\"-\"@ for @stdin@+ -> IO String -- ^ the contents of the file or of standard input+contents pfad = do+ txt <- lazy_contents pfad+ seq (length txt) (return ())+ return txt+++-- |+-- Test for the existence of a path. This is the disjunction of+-- @Directory.doesDirectoryExist@ and @Directory.doesFileExist@. For an dangling symlink, this will return @False@.+path_exists :: String -- ^ Path+ -> IO Bool -- ^ Whether the path exists in the file system+path_exists pfad = do+ de <- doesDirectoryExist pfad+ fe <- doesFileExist pfad+ return (de || fe)+++-- |+-- Test for the existence of a path. This uses @System.Posix.Files.getFileStatus@ to determine whether the path exists in any form in the file system.+-- For a dangling symlink, the result is @True@.+path_exists' :: String -- ^ Path+ -> IO Bool -- ^ Whether the path exists in the file system+path_exists' path =+ catch (do getSymbolicLinkStatus path+ return True)+ (\(ioe :: IOError) -> + if isDoesNotExistError ioe then return False+ else ioError ioe)+ ++-- |+-- Test if path points to a directory. This will return @True@ for a symlink pointing to a directory. It's a shortcut for+-- @Directory.doesDirectoryExist@.+is_dir :: String -- ^ Path+ -> IO Bool -- ^ Whether the path exists and points to a directory.+is_dir = doesDirectoryExist+++-- |+-- Test if path points to a file. This is a shortcut for+-- @Directory.doesFileExist@.+is_file :: String -- ^ Path+ -> IO Bool -- ^ Whether the path exists and points to a file.+is_file = doesFileExist+++-- |+-- This is the @System.Posix.Files.getFileStatus@ function from the GHC libraries, with improved error reporting. The GHC function doesn't include the+-- file name in the @IOError@ when the call fails, making error messages much less useful. @getFileStatus\'@ rectifies this.+--+-- See 'System.Posix.Files.getFileStatus'.+getFileStatus' :: FilePath -- ^ Path of the file, whose status is to be queried+ -> IO FileStatus -- ^ Status of the file+getFileStatus' path =+ getFileStatus path+ `catch` (\ioe -> ioError (ioe { ioe_filename = Just path }))+++-- |+-- This is the @System.Posix.Files.fileAccess@ function from the GHC libraries, with improved error reporting. The GHC function doesn't include the+-- file name in the @IOError@ when the call fails, making error messages much less useful. @fileAccess\'@ rectifies this.+--+-- See 'System.Posix.Files.fileAccess'.+fileAccess' :: FilePath -> Bool -> Bool -> Bool -> IO Bool+fileAccess' p b c d =+ fileAccess p b c d+ `catch` (\ioe -> ioError (ioe { ioe_filename = Just p }))+++-- |+-- Create a temporary file. This will create a new, empty file, with a path which did not previously exist in the file system. The path consists+-- of the specified prefix, a sequence of random characters (digits and letters), and the specified suffix. The file is created with read-write+-- permissions for the user, and no permissons for the group and others. The ownership is set to the effective user ID of the process. The group+-- ownership is set either to the effective group ID of the process or to the group ID of the parent directory (depending on filesystem type and mount+-- options on Linux - see @open(2)@ for details).+--+-- See 'tmp_file', 'temp_dir', 'with_temp_file'.+temp_file :: Int -- ^ Number of random characters to intersperse. Must be large enough, such that most combinations can't already+ -- exist.+ -> String -- ^ Prefix for the path to generate.+ -> String -- ^ Suffix for the path to generate.+ -> IO FilePath -- ^ Path of the created file.+temp_file nr prefix suffix = do+ (fd, path) <- untilIO (do path <- temp_path nr prefix suffix+ fd <- withCString path $ \cpath ->+ {#call hsshellscript_open_nonvariadic#} cpath (o_CREAT .|. o_EXCL) 0o600+ return (fd, path)+ )+ (\(fd, path) ->+ if fd == -1 then do errno <- getErrno+ when (errno /= eEXIST) $+ throwErrno' "temp_file" Nothing (Just path)+ return False+ else return True+ )+ res <- {# call close as c_close #} fd+ when (res == -1) $ throwErrno' "temp_file" Nothing (Just path)+ return path++-- |+-- Create a temporary directory. This will create a new directory, with a path which did not previously exist in the file system. The path consists+-- of the specified prefix, a sequence of random characters (digits and letters), and the specified suffix. The directory is normally created with+-- read-write-execute permissions for the user, and no permissons for the group and others. But this may be further restricted by the process's umask+-- in the usual way.+--+-- The newly created directory will be owned by the effective uid of the process. If the directory containing the it has the set group+-- id bit set, or if the filesystem is mounted with BSD group semantics, the new directory will inherit the group ownership from its parent;+-- otherwise it will be owned by the effective gid of the process. (See @mkdir(2)@)+--+-- See 'tmp_dir', 'temp_file', 'with_temp_dir'.+temp_dir :: Int -- ^ Number of random characters to intersperse. Must be large enough, such that most combinations can't already+ -- exist.+ -> String -- ^ Prefix for the path to generate.+ -> String -- ^ Suffix for the path to generate.+ -> IO FilePath -- ^ Generated path.+temp_dir nr prefix suffix = do+ (_, path) <- untilIO (do path <- temp_path nr prefix suffix+ ret <- withCString path $ \cpath -> {#call mkdir as c_mkdir#} cpath 0o700+ return (ret, path)+ )+ (\(ret, path) ->+ if ret == -1 then do errno <- getErrno+ when (errno /= eEXIST) $+ throwErrno' "temp_dir" Nothing (Just path)+ return False+ else return True+ )+ return path++-- |+-- Create a temporary file. This will create a new, empty file, with read-write permissions for the user, and no permissons for the group and others.+-- The path consists of the specified prefix, a dot, and six random characters (digits and letters).+--+-- @tmp_file prefix = temp_file 6 (prefix ++ \".\") \"\"@+--+-- See 'temp_file', 'tmp_dir', 'with_tmp_file'.+tmp_file :: String -- ^ Prefix for the path to generate.+ -> IO FilePath -- ^ Path of the created file.+tmp_file prefix = temp_file 6 (prefix ++ ".") ""+++-- |+-- Create a temporary directory. This will create a new directory, with read-write-execute permissions for the user (unless further restricted by the+-- process's umask), and no permissons for the group and others.+-- The path consists of the specified prefix, a dot, and six random characters (digits and letters).+--+-- @tmp_dir prefix = temp_dir 6 (prefix ++ \".\") \"\"@+--+-- See 'temp_dir', 'tmp_file', 'with_tmp_dir'.+tmp_dir :: String -- ^ Prefix for the path to generate.+ -> IO FilePath -- ^ Path of the created directory.+tmp_dir prefix = temp_dir 6 (prefix ++ ".") ""+++-- |+-- Create and open a temporary file, perform some action with it, and delete it afterwards. This is a front end to the 'temp_file' function. The file+-- and its path are created in the same way. The IO action is passed a handle of the new file. When it finishes - normally or with an exception -+-- the file is deleted.+--+-- See 'temp_file', 'with_tmp_file', 'with_temp_dir'.+with_temp_file :: Int -- ^ Number of random characters to intersperse. Must be large enough, such that most combinations can't+ -- already exist.+ -> String -- ^ Prefix for the path to generate.+ -> String -- ^ Suffix for the path to generate.+ -> (Handle -> IO a) -- ^ Action to perform.+ -> IO a -- ^ Returns the value returned by the action.+with_temp_file nr prefix suffix io =+ bracket (do path <- temp_file nr prefix suffix+ h <- openFile path ReadWriteMode+ return (path, h)+ )+ (\(path,h) -> do+ hClose h+ removeFile path+ )+ (\(path,h) ->+ io h+ )++++-- |+-- Create a temporary directory, perform some action with it, and delete it afterwards. This is a front end to the 'temp_dir' function. The directory+-- and its path are created in the same way. The IO action is passed the path of the new directory. When it finishes - normally or with an exception -+-- the directory is deleted.+--+-- The action must clean up any files it creates inside the directory by itself. @with_temp_dir@ doesn't delete any files inside, so the directory+-- could be removed. If the directory isn't empty, an @IOError@ results (with the path filled in). When the action throws an exception, and the+-- temporary directory cannot be removed, then the exception is passed through, rather than replacing it with the IOError. (This is because it's+-- probably exactly because of that exception that the directory isn't empty and can't be removed).+--+-- See 'temp_dir', 'with_tmp_dir', 'with_temp_file'.+with_temp_dir :: Int -- ^ Number of random characters to intersperse. Must be large enough, such that most combinations can't+ -- already exist.+ -> String -- ^ Prefix for the path to generate.+ -> String -- ^ Suffix for the path to generate.+ -> (FilePath -> IO a) -- ^ Action to perform.+ -> IO a -- ^ Returns the value returned by the action.+with_temp_dir nr prefix suffix io = + do path <- temp_dir nr prefix suffix+ a <- catch (io path)+ (\e -> do remove path `catch` (\(e::SomeException) -> return ())+ throw (e :: SomeException)+ )+ remove path+ return a+ where+ remove path = removeDirectory path+ `catch` (\ioe -> ioError (ioe { ioe_filename = Just path }))+++-- |+-- Create and open a temporary file, perform some action with it, and delete it afterwards. This is a front end to the 'tmp_file' function. The file+-- and its path are created in the same way. The IO action is passed a handle of the new file. When it finishes - normally or with an exception -+-- the file is deleted.+--+-- See 'tmp_file', 'with_temp_file', 'with_tmp_dir'.+with_tmp_file :: String -- ^ Prefix for the path to generate.+ -> (Handle -> IO a) -- ^ Action to perform.+ -> IO a -- ^ Returns the value returned by the action.+with_tmp_file prefix io =+ bracket (do path <- tmp_file prefix+ h <- openFile path ReadWriteMode+ return (path, h)+ )+ (\(path,h) -> do+ hClose h+ removeFile path+ )+ (\(path,h) -> do+ e <- io h+ return e+ )++-- |+-- Create a temporary directory, perform some action with it, and delete it afterwards. This is a front end to the 'tmp_dir' function. The directory+-- and its path are created in the same way. The IO action is passed the path of the new directory. When it finishes - normally or with an exception -+-- the directory is deleted.+--+-- The action must clean up any files it creates inside the directory by itself. @with_temp_dir@ doesn't delete any files inside, so the directory+-- could be removed. If the directory isn't empty, an @IOError@ results (with the path filled in). When the action throws an exception, and the+-- temporary directory cannot be removed, then the exception is passed through, rather than replacing it with the IOError. (This is because it's+-- probably exactly because of that exception that the directory isn't empty and can't be removed).+--+-- >with_tmp_dir prefix io = with_temp_dir 6 (prefix ++ ".") "" io+--+-- See 'tmp_dir', 'with_temp_dir', 'with_tmp_file'.+with_tmp_dir :: String -- ^ Prefix for the path to generate.+ -> (FilePath -> IO a) -- ^ Action to perform.+ -> IO a -- ^ Returns the value returned by the action.+with_tmp_dir prefix io = with_temp_dir 6 (prefix ++ ".") "" io+++-- |+-- Create a temporary path. This will generate a path which does not yet exist in the file system. It consists of the specified prefix, a+-- sequence of random characters (digits and letters), and the specified suffix.+--+-- /Avoid relying on the generated path not to exist in the file system./ Or else you'll get a potential race condition, since some other process might+-- create the path after @temp_path@, before you use it. This is a security risk. The global random number generator (@Random.randomRIO@) is used to+-- generate the random characters. These might not be that random after all, and could potentially be guessed. Rather use @temp_file@ or @temp_dir@.+--+-- See 'temp_file', 'temp_dir'.+temp_path :: Int -- ^ Number of random characters to intersperse. Must be large enough, such that most combinations can't already+ -- exist.+ -> String -- ^ Prefix for the path to generate.+ -> String -- ^ Suffix for the path to generate.+ -> IO FilePath -- ^ Generated path.+temp_path nr prefix suffix = do+ untilIO (do rand <- sequence (take nr (repeat (fmap char (randomRIO (0, 10+2*26 - 1)))))+ return (prefix ++ rand ++ suffix)+ )+ (\path -> fmap not (path_exists' path))++ where char nr = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" !! nr+++-- Execute action until condition is met.+untilIO io cond = do+ res <- io+ u <- cond res+ if u then return res+ else untilIO io cond+++{- | One entry of mount information. This is the same as @struct mntent@ from @\<mntent.h\>@.+A list of these is returned by the functions which read mount information.++See 'read_mounts', 'read_mtab', 'read_fstab'.+-}+data Mntent = Mntent { mnt_fsname :: String -- ^ Device file (\"name of mounted file system\")+ , mnt_dir :: String -- ^ Mount point+ , mnt_type :: String -- ^ Which kind of file system (\"see mntent.h\")+ , mnt_opts :: String -- ^ Mount options (\"see mntent.h\")+ , mnt_freq :: Int -- ^ Dump frequency in days+ , mnt_passno :: Int -- ^ \"Pass number on parallel fsck\"+ }+ deriving (Read, Show, Typeable, Eq)++{- | Read mount information. This is a front end to the @setmntent(3)@, @getmntent(3)@, @endmntent(3)@ system library functions.++When the @setmntent@ call fails, the @errno@ value is converted to an @IOError@ and thrown.++See 'read_mtab', 'read_fstab'.+-}+read_mounts :: String -- ^ File to read (typically @\/etc\/mtab@ or @\/etc\/fstab@)+ -> IO [Mntent] -- ^ Mount information in that file+read_mounts path = do+ h <- withCString path $ \cpath ->+ withCString "r" $ \r ->+ {#call setmntent#} cpath r+ when (h == nullPtr) $+ throwErrno' "setmntent(3) in read_mounts" Nothing (Just path)+ mntent <- getmntent h []+ {#call endmntent#} h+ return mntent++ where+ getmntent h l = do+ ptr <- {#call getmntent as c_getmntent#} h+ if (ptr == nullPtr) then return l+ else do mnt_fsname_str <- {#get mntent.mnt_fsname#} ptr >>= peekCString+ mnt_dir_str <- {#get mntent.mnt_dir#} ptr >>= peekCString+ mnt_type_str <- {#get mntent.mnt_type#} ptr >>= peekCString+ mnt_opts_str <- {#get mntent.mnt_opts#} ptr >>= peekCString+ mnt_freq_int <- fmap fromEnum $ {#get mntent.mnt_freq#} ptr+ mnt_passno_int <- fmap fromEnum $ {#get mntent.mnt_passno#} ptr+ getmntent h (l ++ [Mntent { mnt_fsname = mnt_fsname_str+ , mnt_dir = mnt_dir_str+ , mnt_type = mnt_type_str+ , mnt_opts = mnt_opts_str+ , mnt_freq = mnt_freq_int+ , mnt_passno = mnt_passno_int+ }])++{- | Get the currently mounted file systems.++>read_mtab = read_mounts "/etc/mtab"++See 'read_mounts'.+-}+read_mtab :: IO [Mntent]+read_mtab = read_mounts "/etc/mtab"+++{- | Get the system wide file system table.++>read_fstab = read_mounts "/etc/fstab"++See 'read_mounts'.+-}+read_fstab :: IO [Mntent]+read_fstab = read_mounts "/etc/fstab"+++-- Taken from the source code of the GHC 6 libraries (in System.Posix.Internals). It isn't exported from there. "HsBase.h" belongs to the files which+-- are visible to users of GHC, but it isn't documented. The comment at the beginning says "Definitions for package `base' which are visible in+-- Haskell land.".+foreign import ccall unsafe "HsBase.h __hscore_o_creat" o_CREAT :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_excl" o_EXCL :: CInt+++-- | Change the working directory temporarily. This executes the specified IO action with a new working directory, and restores it afterwards+-- (exception-safely).+with_wd :: FilePath -- ^ New working directory+ -> IO a -- ^ Action to run+ -> IO a+with_wd wd io =+ bracket (do cwd <- getCurrentDirectory+ setCurrentDirectory wd+ return cwd)+ (\cwd -> setCurrentDirectory cwd)+ (const io)+++-- | This is an interface to the POSIX @glob@ function, which does wildcard expansion+-- in paths. The list of matched paths is returned. It's empty+-- for no match (rather than the original pattern). In case anything goes wrong+-- (such as permission denied), an IOError is thrown.+--+-- This does /not/ do tilde expansion, which is done (among many unwanted other+-- things) by @wordexp@. The only flag used for the call to @glob@ is @GLOB_ERR@.+--+-- The behaviour in case of non-existing path components is inconsistent in the+-- GNU version of the underlying @glob@ function. @glob "\/doesnt_exist\/foo"@ will return+-- the empty list, whereas @glob "\/doesnt_exist\/*"@ causes a "No such file or directory"+-- IOError.+--+-- See man pages @glob(3)@ and @wordexp(3)@.+glob :: String -- ^ Pattern+ -> IO [String] -- ^ Sorted list of matching paths+glob pattern = do+ withCString pattern $ \pattern_ptr ->+ allocaBytes {#sizeof glob_t#} $ \buf_ptr ->+ do res <- {#call do_glob#} buf_ptr pattern_ptr+ case res of+ 0 -> -- success+ do pptr <- {#get glob_t->gl_pathv#} buf_ptr+ len <- lengthArray0 nullPtr pptr+ cstrs <- peekArray len pptr+ mapM peekCString cstrs+ 1 -> -- GLOB_ABORTED+ throwErrno' "glob" Nothing (Just pattern)+ 2 -> -- GLOB_NOSPACE+ ioError (ioeSetErrorString (mkIOError ResourceExhausted "glob" Nothing (Just pattern))+ "Out of memory")+ 3 -> -- GLOB_NOMATCH+ return []+ `finally`+ (do pptr <- {#get glob_t->gl_pathv#} buf_ptr+ when (pptr /= nullPtr) $+ {#call globfree#} buf_ptr+ )++++#c+/*+#include <unistd.h>+#include <errno.h>+#include <stdio.h>+#include <fcntl.h>+#include <sys/types.h>+*/+#include <mntent.h>+#include <sys/stat.h>+#include <glob.h>++int close(int fd);+++/* open(2) is defined in fcntl.h as "extern int open (__const char *__file, int __oflag, ...)", with variable number of arguments, which isn's+ supported by the FFI.+*/+int hsshellscript_open_nonvariadic(const char *pathname, int flags, mode_t mode);++int do_glob(void* buf, const char* pattern);+++#endc
+ src/HsShellScript/Paths.hs view
@@ -0,0 +1,464 @@+-- Path parsing and composing++-- #hide+module HsShellScript.Paths where++import Data.List+import System.Directory++{- | Split a path in components. Repeated \"@\/@\" characters don\'t lead to empty+components. \"@.@\" path components are removed. If the path is absolute, the first component+will start with \"@\/@\". \"@..@\" components are left intact. They can't be simply+removed, because the preceding component might be a symlink. In this case,+'realpath' is probably what you need.++The case that the path is empty is treated like \"@.@\", yielding an empty path components list.++Examples:++>slice_path "/" = ["/"]+>slice_path "/foo/bar" = ["/foo","bar"]+>slice_path "..//./" = [".."]+>slice_path "." = []+>slice_path "" = []++See 'unslice_path', 'realpath', 'realpath_s'.+-}+slice_path :: String -- ^ The path to be broken to components.+ -> [String] -- ^ List of path components.+slice_path p =+ case p of+ ('/':p') -> case slice_path' p' of+ [] -> ["/"]+ (c:cs) -> (('/':c):cs)+ _ -> slice_path' p+ where+ slice_path' p = filter (\c -> c /= "" && c /= ".") (split p)++ split "" = []+ split ('/':p) = "" : split p+ split (x:xs) = case split xs of+ [] -> [[x]]+ (y:ys) -> ((x:y):ys)++{- | Form a path from path components. This isn't the inverse+of 'slice_path', since @'unslice_path' . 'slice_path'@+normalises the path.++>unslice_path [] = "."+>unslice_path cs = concat (intersperse "/" cs)++See 'slice_path', 'unsplit_parts'.+-}+unslice_path :: [String] -- ^ List of path components+ -> String -- ^ The path which consists of the supplied path components+unslice_path [] = "."+unslice_path cs = concat (intersperse "/" cs)+++{- | Normalise a path. This is done by reducing repeated @\/@ characters to one, and removing+ @.@ path components. @..@ path components are left intact, because of possible symlinks.++ Note that the normalised path isn't 100% equivalent to the original one. Any trailing slash is removed. When the last path component is a symbolic+ link, then both paths denote the same thing, except for in the context of the 'readlink' call. It will fail when the trailing slash is present+ (because then the path denotes the directory which the link points to), but it will succeed when it is absent.++ >normalise_path = unslice_path . slice_path++ See 'unslice_path', 'slice_path'.+-}+normalise_path :: String -- ^ Path to be normalised+ -> String -- ^ Path in normalised form+normalise_path = unslice_path . slice_path+++{- | Split a file name in components. This are the base file name and the+suffixes, which are separated by dots. If the name starts with a dot, it is+regarded as part of the base name. The result is a list of file name+components. The filename may be a path. In this case, everything up to the+last path component will be returned as part of the base file name. The+path gets normalised thereby.++No empty suffixes are returned. If the file name contains several+consecutive dots, they are regared as part of the preceding file name+component.++Concateneting the name components and adding dots, reproduces the+original name, with a normalised path:+@concat . intersperse \".\" . 'slice_filename' == 'normalise'@.++Note that the last path component might be \"@..@\". Then it is not+possible to deduce the refered directory's name from the path. An IO+action for getting the real path is then necessary.++Examples:++>slice_filename "a.b//./.foo.tar.gz" = ["a.b/.foo","tar","gz"]+>slice_filename ".x..y." = [".x.", "y."]++See 'unslice_filename', @slice_filename\'@.+-}+slice_filename :: String -- ^ Path+ -> [String] -- ^ List of components the file name is made up of+slice_filename path =+ let comps = slice_path path+ in if comps == []+ then []+ else -- slice_filename' result not empty, because comps not empty+ let (base:suffixes) = slice_filename' (last comps)+ in (unslice_path (init comps ++ [base]) : suffixes)+++{- | This is a variant of 'slice_filename'. It is like 'slice_filename', except for+being more efficient, and the filename must not contain any preceding path,+since this case isn't considered.++See 'slice_filename', 'unslice_filename'.+-}+slice_filename' :: String -- ^ File name without path+ -> [String] -- ^ List of components the file name is made up of+slice_filename' filename =+ case filename of+ ('.':filename') -> case slice_filename'' filename' of+ [] -> ["."]+ (t:ts) -> ('.':t) : ts+ filename -> slice_filename'' filename+ where+ slice_filename'' :: String -> [String]+ slice_filename'' "" = []+ slice_filename'' fn =+ let (beg,rest) = split1 fn+ in (beg : slice_filename'' rest)++ split1 :: String -> (String, String)+ split1 (x:y:r) =+ if x == '.' && y /= '.' then ("", y:r)+ else let (beg,rest) = split1 (y:r)+ in (x:beg,rest)+ split1 str = (str, "")++++{- | Form file name from file name components, interspersing dots. This is+the inverse of 'slice_filename', except for normalisation of any path.++> unslice_filename = concat . intersperse "."++See 'slice_filename'.+-}+unslice_filename :: [String] -- ^ List of file name components+ -> String -- ^ Name of the file which consists of the supplied components+unslice_filename = concat . intersperse "."+++{- | Split a path in directory and file name. Only in the case that the+supplied path is empty, both parts are empty strings. Otherwise, @\".\"@ is filled in+for the corresponding part, if necessary. Unless the path is empty,+concatenating the returned path and file name components with a slash in+between, makes a valid path to the file.++@split_path@ splits off the last path component. This+isn't the same as the text after the last @\/@.++Note that the last path component might be @\"..\"@. Then it is not+possible to deduce the refered directory's name from the path. Then an IO+action for getting the real path is necessary.++Examples:++>split_path "/a/b/c" == ("/a/b", "c")+>split_path "foo" == (".", "foo")+>split_path "foo/bar" == ("foo", "bar")+>split_path "foo/.." == ("foo", "..")+>split_path "." == (".", ".")+>split_path "" == ("", "")+>split_path "/foo" == ("/", "foo")+>split_path "foo/" == (".", "foo")+>split_path "foo/." == (".", "foo")+>split_path "foo///./bar" == ("foo", "bar")+>split_path "/" == ("/", ".")++See 'slice_path'.+-}+split_path :: String -- ^ Path to be split+ -> (String, String) -- ^ Directory and file name components of the path. The directory path is normalized.+split_path "" = ("","")+split_path path =+ case slice_path path of+ [] -> (".",".")+ ["/"] -> ("/", ".")+ ['/':p] -> ("/", p)+ [fn] -> (".", fn)+ parts -> ( unslice_path (init parts)+ , last parts+ )++{- | Get the directory part of a path.++>dir_part = fst . split_path++See 'split_path'.+-}+dir_part :: String -> String+dir_part = fst . split_path+++{- | Get the last path component of a path.++>filename_part = snd . split_path++Examples:++>filename_part "foo/bar" == "bar"+>filename_part "." == "."++See 'split_path'.+-}+filename_part :: String -> String+filename_part = snd . split_path+++{- | Inverse of 'split_path', except for normalisation.++This forms a path from two parts, and takes care of @\".\"@ and empty parts. When the two components are in normalised form, then @unsplit_path@+creates a normalised path.++The definition:++>unsplit_path ("", "") = ""+>unsplit_path (p, q) = unsplit_parts [p, q]++Examples:++>unsplit_path ("", "") == ""+>unsplit_path (".", "") == "."+>unsplit_path (".", ".") == "."+>unsplit_path ("foo", ".") == "foo"++See 'split_path', 'slice_path', 'unsplit_parts'.+-}+unsplit_path :: ( String, String ) -- ^ Directory and file name+ -> String -- ^ Path formed from the directory and file name parts+unsplit_path ("", "") = ""+unsplit_path (p, q) = unsplit_parts [p, q]++{- old definition:+unsplit_path (".", "") = "."+unsplit_path ("", ".") = "."+unsplit_path (".", q) = q+unsplit_path ("", q) = q+unsplit_path (p, "") = p+unsplit_path (p, ".") = p+unsplit_path (p, q) = p ++ "/" ++ q+-}+++{- | Concatenate a list of path parts. The idea is that you can throw in reasonably formed parts, and get a reasonably+formed version of the concatenated path out.++@\".\"@ parts are removed. Empty parts are treated as @\".\"@ parts. One leading slash in each of any but the first part is removed. The result is+then interspersed with slashes and string wise concatenated. The interior of the parts isn't examined. @\"..\"@ components aren't treated specially.++Examples:++>unsplit_parts [] == "."+>unsplit_parts [""] == "."+>unsplit_parts ["/"] == "/"+>unsplit_parts ["/", "foo"] == "/foo"+>unsplit_parts ["", "/foo"] == "foo"+>unsplit_parts ["/foo", "bar"] == "/foo/bar"+>unsplit_parts ["/foo", "/bar"] == "/foo/bar"+>unsplit_parts ["foo/", "bar"] == "foo//bar"+>unsplit_parts ["foo", "", ".", "bar"] == "foo/bar"+>unsplit_parts ["foo", "bar//./baz/"] == "foo/bar//./baz/"++See 'unsplit_path', 'unslice_path', 'split_path'.+-}+unsplit_parts :: [String] -- ^ List of path parts to concatenate.+ -> String -- ^ Formed path, which concatenates the parts.+unsplit_parts [] = "."+unsplit_parts parts =+ let abs = case parts of+ ('/':p1):rest -> "/"+ _ -> ""+ parts' = map (\part -> case part of+ '/':rest -> rest+ _ -> part+ )+ parts+ in case (abs ++ (concat $ intersperse "/" $ filter (\part -> part /= "" && part /= ".") parts'))+ of "" -> "."+ path -> path+++{- | Split a file name in prefix and suffix. If there isn't any suffix in+the file name, then return an empty suffix. A dot at the beginning or at+the end is not regarded as introducing a suffix.++The last path component is what is being split. This isn't the same as+splitting the string at the last dot. For instance, if the file name+doesn't contain any dot, dots in previous path component's aren't mistaken+as introducing suffixes.++The path part is returned in normalised form. This means, @\".\"@ components+are removed, and multiple \"@\/@\"s are reduced to one.++Note that there isn't any plausibility check performed on the suffix. If the file name doesn't have a suffix, but happens to contain a dot, then this+dot is mistaken as introducing a suffix.++Examples:++>split_filename "path/to/foo.bar" = ("path/to/foo","bar")+>split_filename "path/to/foo" = ("path/to/foo","")+>split_filename "/path.to/foo" = ("/path.to/foo","")+>split_filename "a///./x" = ("a/x","")+>split_filename "dir.suffix/./" = ("dir","suffix")+>split_filename "Photographie, Das 20. Jahrhundert (300 dpi)" = ("Photographie, Das 20", " Jahrhundert (300 dpi)")++See 'slice_path', 'split_filename\''+-}+split_filename :: String -- ^ Path including the file name to be split+ -> (String, String) -- ^ The normalised path with the file prefix, and the file suffix.+split_filename "" = ("", "")+split_filename path =+ case slice_path path of+ [] -> (".","")+ comps -> let (pref_fn, suff_fn) = split_filename' (last comps)+ in ( concat (intersperse "/" (init comps ++ [pref_fn]))+ , suff_fn+ )+++{- | Variant of 'split_filename'. This is a more efficient version+of 'split_filename', for the case that you know the string is+is a pure file name without any slashes.++See 'split_filename'.+-}+split_filename' :: String -- ^ Filename to be split+ -> (String, String) -- ^ Base name and the last suffix+split_filename' "" = ("", "")+split_filename' fn =+ let parts = slice_filename' fn+ in case parts of+ [] -> (".", "")+ [base] -> (base, "")+ p -> (unslice_filename (init p), last p)+++{- | Inverse of 'split_filename'. Concatenate prefix and suffix, adding+a dot in between, iff the suffix is not empty. The path part of the prefix is+normalised.++See 'split_filename'.+-}+unsplit_filename :: (String, String) -- ^ File name prefix and suffix+ -> String -- ^ Path+unsplit_filename (prefix, suffix) =+ if suffix == "" then prefix else prefix ++ "." ++ suffix+++{- | Split a path in directory, base file name and suffix.+-}+split3 :: String -- ^ Path to split+ -> (String, String, String) -- ^ Directory part, base file name part and suffix part+split3 "" = ("","","")+split3 path =+ let comps = slice_path path+ (base, suffix) = split_filename' (last comps)+ in (unslice_path (init comps), base, suffix)+++{- |+Form path from directory, base file name and suffix parts.+-}+unsplit3 :: (String, String, String) -- ^ Directory part, base file name part and suffix part+ -> String -- ^ Path consisting of dir, base and suffix+unsplit3 (dir, base, suffix) =+ unsplit_path (dir, (unsplit_filename (base,suffix)))+++{- | Test a path for a specific suffix and split it off.++If the path ends with the suffix, then the result is @Just+prefix@, where @prefix@ is the normalised path+without the suffix. Otherwise it's @Nothing@.+-}+test_suffix :: String -- ^ Suffix to split off+ -> String -- ^ Path to test+ -> Maybe String -- ^ Prefix without the suffix or @Nothing@+test_suffix suffix path =+ let (prefix, suff) = split_filename path+ in if suff == suffix then Just prefix+ else Nothing+++{- | Make a path absolute, using the current working directory.++This makes a relative path absolute with respect to the current+working directory. An absolute path is returned unmodified.++The current working directory is determined with @getCurrentDirectory@+which means that symbolic links in it are expanded and the path is+normalised. This is different from @pwd@.+-}+absolute_path :: String -- ^ The path to be made absolute+ -> IO String -- ^ Absulte path+absolute_path path@('/':p) = return path+absolute_path path = do+ cwd <- getCurrentDirectory+ return (cwd ++ "/" ++ path)+++{- | Make a path absolute.++This makes a relative path absolute with respect to a specified+directory. An absolute path is returned unmodified.+-}+absolute_path_by :: String -- ^ The directory relative to which the path is made absolute+ -> String -- ^ The path to be made absolute+ -> String -- ^ Absolute path+absolute_path_by dir path@('/':p) = path+absolute_path_by dir path = dir ++ "/" ++ path+++{- | Make a path absolute.++This makes a relative path absolute with respect to a specified+directory. An absolute path is returned unmodified.++The order of the arguments can be confusing. You should rather use 'absolute_path_by'. @absolute_path\'@ is included for backwards compatibility.+-}+absolute_path' :: String -- ^ The path to be made absolute+ -> String -- ^ The directory relative to which the path is made absolute+ -> String -- ^ Absolute path+absolute_path' path@('/':p) dir = path+absolute_path' path dir = dir ++ "/" ++ path+++{- | Guess the @\"..\"@-component free form of a path, specified as a list of path components, by syntactically removing them, along with the preceding+ path components. This will produce+ erroneous results when the path contains symlinks. If the path contains leading @\"..\"@ components, or more @\"..\"@ components than preceeding normal+ components, then the @\"..\"@ components can't be normalised away. In this case, the result is @Nothing@.+-}+guess_dotdot_comps :: [String] -- ^ List of path components+ -> Maybe [String] -- ^ In case the path could be transformed, the @\"..\"@-component free list of path components.+guess_dotdot_comps = guess_dotdot_comps' []+ where+ guess_dotdot_comps' schon [] = Just schon+ guess_dotdot_comps' [] ("..":_) = Nothing+ guess_dotdot_comps' schon ("..":teile) = guess_dotdot_comps' (reverse . tail . reverse $ schon) teile+ guess_dotdot_comps' schon (teil:teile) = guess_dotdot_comps' (schon ++ [teil]) teile+++{- | Guess the @\"..\"@-component free, normalised form of a path. The transformation is purely syntactic. @\"..\"@ path components will be removed, along+ with their preceding path components. This will produce+ erroneous results when the path contains symlinks. If the path contains leading @\"..\"@ components, or more @\"..\"@ components than preceeding normal+ components, then the @\"..\"@ components can't be normalised away. In this case, the result is @Nothing@.++>guess_dotdot = fmap unslice_path . guess_dotdot_comps . slice_path+-}+guess_dotdot :: String -- ^ Path to be normalised+ -> Maybe String -- ^ In case the path could be transformed, the normalised, @\"..\"@-component free form of the path.+guess_dotdot =+ fmap unslice_path . guess_dotdot_comps . slice_path
+ src/HsShellScript/ProcErr.chs view
@@ -0,0 +1,1949 @@+-- Ausnahme in child, Exception+-- #hide+module HsShellScript.ProcErr where++import Control.Concurrent.MVar+import Control.Exception+import Control.Monad+import Data.IORef as IORef+import Data.Int+import Data.List+import Data.Maybe+import Data.Typeable+import Foreign+import Foreign.C+import Foreign.C.Error+import GHC.Conc+import GHC.IO hiding (finally, bracket)+import GHC.IO.Exception -- SystemError, ioe_*+import GHC.IO.Handle+import GHC.IO.Handle.Internals -- withHandle', do_operation+import GHC.IO.Handle.Types hiding (close)+import HsShellScript.Args+import HsShellScript.Shell+import Prelude hiding (catch)+import System.Directory+import System.Environment+import System.Exit+import System.IO+import System.IO.Error hiding (catch)+import System.Posix+import System.Posix.IO+import System.Posix.Process (forkProcess)+import System.Posix.Types -- Fd+import qualified GHC.IO.FD as FD+import qualified System.IO.Error -- mkIOError++infixr 2 -|- -- left handed, stdout+infixr 2 =|- -- left handed, stderr+infixl 2 -|= -- right handed, stdout+infixl 2 =|= -- right handed, stderr+infixl 3 ->- -- write stdout to file+infixl 3 =>- -- write stderr to file+infixl 3 ->>- -- append stdout to file+infixl 3 =>>- -- append stderr to file+infixl 3 -<- -- read stdin from file or string+infixl 3 -&>- -- write stdout and stderr to file+infixl 3 -&>>- -- append stdout and stderr to file++++{- | Improved version of @System.Posix.Files.setFileMode@, which sets the file name in the @IOError@ which is thrown in case of an error. The+ implementation in GHC 6.2.2 neglects to do this.++>setFileMode' path mode =+> fill_in_filename path $+> setFileMode path mode+-}+setFileMode' :: FilePath -> FileMode -> IO ()+setFileMode' path mode =+ fill_in_filename path $+ setFileMode path mode+++-- |+-- Execute an IO action as a separate process, and wait for it to finish.+-- Report errors as exceptions.+--+-- The program forks a child process and performs the specified action.+-- Then it waits for the child process to finish. If it exits in any way+-- which indicates an error, the @ProcessStatus@ is thrown as an+-- exception.+--+-- When the action throws an @IOError@, it is transmitted to the parent.+-- It is then raised there, as if it happened locally. The child then aborts+-- quietly with an exit code of 0.+--+-- When used in conjunction with an @exec@ variant, this means that the parent+-- process can tell the difference between failure of the @exec@ call itself,+-- and failure of the program being executed. You get the @IOError@, which+-- happened in the child when calling @executeFile@ (GHC hierarchical+-- libraries). Of course, the action can prevent this form happening, by+-- itself catching @IOError@s.+--+-- The parent process waits for the child process, if it has been stopped by a+-- signal.+--+-- See "HsShellScript#subr" for further details.+--+--+-- Examples:+--+-- Run a program with the environment replaced:+--+-- >subproc (execpe "foobar" ["1","2","3"] new_env)+--+-- This results in a @ProcessStatus@ exception:+--+-- >subproc (exec "/bin/false" [])+--+-- This results in an @IOError@ (unless you actually have @\/frooble@):+--+-- >subproc (exec "/frooble" [])+--+-- See 'runprog', 'spawn', 'exec', 'execp', 'exece', 'execpe'.+subproc :: IO a -- ^ Action to execute in a child process+ -> IO ()+subproc io = do++ -- Make new error channel+ (readend, writeend) <- createPipe++ -- Set it to "close on exec"+ {#call c_close_on_exec#} (fromIntegral writeend)++ -- Fork child process+ flush_outerr+ pid <- forkProcess (do -- Child process+ closeFd readend++ -- Do it. In case some part of the child hands over an IOError to+ -- be transmitted to the parent, do that and abort quietly.+ child $+ catch (io >> return ())+ (\(ioe::IOError) -> do+ send_ioerror writeend ioe+ flush_outerr+ _exit 0+ )+ )++ -- Parent process+ closeFd writeend++ -- Read the complete contents of the error channel as an encoding+ -- of a possible IOError (until closed on the other side).+ --+ -- The write end in the child stays open, until either+ -- - exec in the child+ -- - child terminates (not merely stops)+ -- - child sends ioerror and closes the channel+ mioe <- receive_ioerror readend++ -- Waits for the child to finish. The process status is "Exited+ -- ExitSuccess" in case the child transmitted an error.+ (Just ps) <- getProcessStatus True False (fromIntegral pid)+ if ps == Exited ExitSuccess+ then return ()+ else throw ps++ -- In case an IOError has been received, throw it locally+ case mioe of+ Just ioe -> ioError ioe+ Nothing -> return ()+++-- |+-- Execute an IO action as a separate process, and wait for it to finish.+-- Report errors as exceptions.+--+-- /This function is included only for backwards compatibility. New code should/+-- /use/ 'subproc' instead/, which has better error handling./+--+-- The program forks a child process and performs the specified action.+-- Then it waits for the child process to finish. If it exits in any way+-- which indicates an error, the @ProcessStatus@ is thrown.+--+-- The parent process waits for the child processes, which have been stopped by+-- a signal.+--+-- See "HsShellScript#subr" for further details.+--+-- See 'subproc', 'spawn'.+call :: IO a -- ^ action to execute as a child process+ -> IO ()+call io = do+ pid <- spawn_loc "call" io+ (Just ps) <- getProcessStatus True False pid+ if ps == Exited ExitSuccess+ then return ()+ else throw ps+++-- |+-- Execute an IO action as a separate process, and continue without waiting+-- for it to finish.+--+-- The program forks a child process, which performs the specified action and terminates.+-- The child's process ID is returned.+--+-- See "HsShellScript#subr" for further details.+--+-- See 'subproc'.+spawn :: IO a -- ^ Action to execute as a child process.+ -> IO ProcessID -- ^ Process ID of the new process.+spawn = spawn_loc "spawn"++spawn_loc :: String -> IO a -> IO ProcessID+spawn_loc loc io = do+ flush_outerr+ pid <- forkProcess (child io)+ return pid+++-- |+-- Run an external program. This starts a program as a child+-- process, and waits for it to finish. The executable is searched via the+-- @PATH@.+--+-- /This function is included for backwards compatibility only. New code should/+-- /use/ 'runprog'/, which has much better error handling./+--+-- When the specified program can't be executed, an error message is printed, and the main process+-- gets a @ProcessStatus@ thrown, with the value @Exited+-- (ExitFailure 1)@. This means that the main program can't distinguish between+-- failure of calling the program and the program exiting with an exit code of+-- 1. However, an error message \"Error calling ...\", including the description in the IOError produced+-- by the failed @execp@ call, is printed on @stderr@.+--+-- @run prog par@ is essentially @call (execp prog par)@.+--+-- Example:+--+-- >run "/usr/bin/foobar" ["some", "args"]+-- > `catch` (\ps -> do -- oops...+-- > )+--+-- See 'runprog', 'subproc', 'spawn'.+run :: FilePath -- ^ Name of the executable to run+ -> [String] -- ^ Command line arguments+ -> IO ()+run prog par =+ call (child $ execp prog par)++++{- | An error which occured when calling an external program via 'runprog'.+ The fields specifiy the details of the call.++ See 'show_runerror', 'to_ioe', 'as_ioe', @System.Posix.ProcessStatus@.+-}+data RunError = RunError+ { re_prog :: String -- ^ Program name+ , re_pars :: [String] -- ^ Program arguments+ , re_env :: [(String,String)] -- ^ The environment in use when the call was done+ , re_wd :: String -- ^ The working directory when the call was done+ , re_ps :: ProcessStatus -- ^ The process status of the failure+ , re_errno :: Maybe CInt -- ^ The error (errno) code+ }+ deriving (Show, Typeable, Eq)++instance Exception RunError++++-- | Make a readable error message. This includes all the+-- fields of @RunError@ except for the environment.+--+-- See 'RunError'.+show_runerror :: RunError -> String+show_runerror re =+ "The following program failed:\n\+ \ " ++ shell_command (re_prog re) (re_pars re) ++ "\n" +++ explain_processstatus (re_ps re) ++ "\n\+ \The working directory was " ++ quote (re_wd re) ++ "."+++-- | Generate a human-readable description of a @ProcessStatus@.+--+-- See 'exec', 'runprog' and @System.Posix.ProcessStatus@ in the GHC hierarchical+-- library documentation.+explain_processstatus :: ProcessStatus -> String+explain_processstatus ps =+ case ps of+ Exited (ExitFailure ec) -> "The program exited abnormally with an exit code of " ++ show ec ++ "."+ Exited ExitSuccess -> "The program finished normally."+ Terminated sig -> "The process was terminated by signal " ++ showsig sig ++ "."+ Stopped sig -> "The process was stopped by signal " ++ showsig sig ++ "."+ where+ showsig sig = show sig +++ case lookup sig signals of+ Just name -> " (" ++ name ++ ")"+ Nothing -> ""++ signals = [(sigABRT, "SIGABRT"), (sigALRM, "SIGALRM"), (sigBUS, "SIGBUS"), (sigCHLD, "SIGCHLD"), (sigCONT, "SIGCONT"), (sigFPE, "SIGFPE"),+ (sigHUP, "SIGHUP"), (sigILL, "SIGILL"), (sigINT, "SIGINT"), (sigKILL, "SIGKILL"), (sigPIPE, "SIGPIPE"), (sigQUIT, "SIGQUIT"),+ (sigSEGV, "SIGSEGV"), (sigSTOP, "SIGSTOP"), (sigTERM, "SIGTERM"), (sigTSTP, "SIGTSTP"), (sigTTIN, "SIGTTIN"), (sigTTOU, "SIGTTOU"),+ (sigUSR1, "SIGUSR1"), (sigUSR2, "SIGUSR2"), (sigPOLL, "SIGPOLL"), (sigPROF, "SIGPROF"), (sigSYS, "SIGSYS"), (sigTRAP, "SIGTRAP"),+ (sigURG, "SIGURG"), (sigVTALRM, "SIGVTALRM"), (sigXCPU, "SIGXCPU"), (sigXFSZ, "SIGXFSZ")]+++-- | Convert a @RunError@ to an @IOError@.+--+-- The @IOError@ type isn't capable of holding all the information which is+-- contained in a @RunError@. The environment is left out, and most of the other+-- fields are included only informally, in the description.+--+-- The fields of the generated @IOError@ are:+--+-- * The handle (@ioeGetHandle@): @Nothing@+--+-- * The error type (@ioeGetErrorType@): @GHC.IO.Exception.SystemError@+--+-- * @ioe_location@: @\"runprog\"@+--+-- * @ioe_description@: The error message, as procuded by @show_runerror@.+--+-- * @ioe_filename@: This is @Just (shell_command /prog/ /pars/)@, with /prog/+-- and /pars/ being the program and its arguments.+--+-- See 'as_ioe', 'runprog', 'show_runerror'.+to_ioe :: RunError -> IOError+to_ioe re =+ GHC.IO.Exception.IOError { ioe_handle = Nothing,+ ioe_type = GHC.IO.Exception.SystemError,+ ioe_location = "runprog",+ ioe_description = show_runerror re,+ ioe_filename = Just (shell_command (re_prog re) (re_pars re)),+ ioe_errno = re_errno re+ }+++-- | Call the specified IO action (which is expected to contain calls of+-- @runprog@) and convert any @RunError@ exceptions to @IOError@s.+--+-- The conversion is done by @to_ioe@.+--+-- See 'to_ioe', 'runprog'.+as_ioe :: IO a -> IO a+as_ioe io =+ io+ `catch` (\(re::RunError) -> ioError (to_ioe re))+++-- |+-- Run an external program, and report errors as exceptions. The executable is+-- searched via the @PATH@.+--+-- In case the program exits in an way which indicates an error, or is+-- terminated by a signal, a @RunError@ is thrown. It+-- contains the details of the call. The @runprog@ action can also be converted+-- to throw @IOError@s instaed, by applying @as_ioe@ to it. Either can be used+-- to generate an informative error message.+--+-- In case of starting the program itself failed, an @IOError@ is thrown.+--+-- @runprog prog par@ is essentially @subproc (execp prog par)@.+--+-- Example 1:+--+-- >do runprog "foo" ["some", "args"]+-- > ...+-- >`catch` (\re -> do errm (show_runerror re)+-- > ...+-- > )+--+-- Example 2:+--+-- >do as_ioe $ runprog "foo" ["some", "args"]+-- > ...+-- >`catch` (\ioe -> do errm (show_ioerror ioe)+-- > ...+-- > )+--+-- See 'subproc', 'spawn', 'RunError', 'show_runerror', 'to_ioe', 'as_ioe'.+runprog :: FilePath -- ^ Name of the executable to run+ -> [String] -- ^ Command line arguments+ -> IO ()+runprog prog pars =+ subproc (execp prog pars)++ `catch`+ -- Convert ProcessStatus error to RunError+ (\(ps::ProcessStatus) ->+ do env <- System.Environment.getEnvironment+ wd <- getCurrentDirectory+ (Errno c_errno) <- getErrno+ throw (RunError { re_prog = prog+ , re_pars = pars+ , re_env = env+ , re_wd = wd+ , re_ps = ps+ , re_errno = if c_errno /= (0::CInt) then Just c_errno+ else Nothing+ }))++++-- | Print an action as a shell command, then perform it.+--+-- This is used with actions such as 'runprog', 'exec' or 'subproc'. For instance,+-- @echo runprog prog args@ is a variant of @runprog prog args@, which prints what+-- is being done before doing it.+--+-- See 'runprog', 'subproc', 'exec'.+echo :: ( FilePath -> [String] -> IO () ) -- ^ Action to perform+ -> FilePath -- ^ Name or path of the executable to run+ -> [String] -- ^ Command line arguments+ -> IO ()+echo action path args = do+ putStrLn (shell_command path args)+ action path args+++-- | Execute an external program. This replaces the running process. The path isn't searched, the environment isn't changed. In case of failure,+-- an IOError is thrown.+--+-- >exec path args =+-- > execute_file path False args Nothing+--+-- See 'execute_file', "HsShellScript#exec".+exec :: String -- ^ Full path to the executable+ -> [String] -- ^ Command line arguments+ -> IO a -- ^ Never returns+exec path args =+ execute_file path False args Nothing+++-- | Execute an external program. This replaces the running process. The path is searched, the environment isn't changed. In case of failure,+-- an IOError is thrown.+--+-- >execp prog args =+-- > execute_file prog True args Nothing+--+-- See 'execute_file', "HsShellScript#exec".+execp :: String -- ^ Name or path of the executable+ -> [String] -- ^ Command line arguments+ -> IO a -- ^ Never returns+execp prog args =+ execute_file prog True args Nothing+++-- | Execute an external program. This replaces the running process. The path isn't searched, the environment of the program is set as specified. In+-- case of failure, an IOError is thrown.+--+-- >exece path args env =+-- > execute_file path False args (Just env)+--+-- See 'execute_file', "HsShellScript#exec".+exece :: String -- ^ Full path to the executable+ -> [String] -- ^ Command line arguments+ -> [(String,String)] -- ^ New environment+ -> IO a -- ^ Never returns+exece path args env =+ execute_file path False args (Just env)+++-- | Execute an external program. This replaces the running process. The path is searched, the environment of the program is set as specified. In+-- case of failure, an IOError is thrown.+--+-- >execpe prog args env =+-- > execute_file prog True args (Just env)+--+-- See 'execute_file', "HsShellScript#exec".+execpe :: String -- ^ Name or path of the executable+ -> [String] -- ^ Command line arguments+ -> [(String,String)] -- ^ New environment+ -> IO a -- ^ Never returns+execpe prog args env =+ execute_file prog True args (Just env)+++{- | Build left handed pipe of stdout.++ \"@p -|- q@\" builds an IO action from the two IO actions @p@ and @q@.+ @q@ is executed in an external process. The standard output of @p@ is sent+ to the standard input of @q@ through a pipe. The result action consists+ of forking off @q@ (connected with a pipe), and @p@.++ The result action does /not/ run @p@ in a separate process. So, the pipe+ itself can be seen as a modified action @p@, forking a connected @q@. The+ pipe is called \"left handed\", because @p@ remains unforked, and not @q@.++ /The exit code of q is silently ignored./ The process ID of the forked+ copy of @q@ isn't returned to the caller, so it's lost.++ See "HsShellScript#subr" and+ "HsShellScript#exec" for further details.++ Examples:++ >call (exec "/usr/bin/foo" [] -|- exec "/usr/bin/bar" [])++ >call ( execp "foo" ["..."]+ > -|= ( -- Do something with foo's output+ > do cnt <- lazy_contents "-"+ > ...+ > )+ > )++ See 'subproc', '(=|-)', '(-|=)'.+-}+(-|-) :: IO a -- ^ Action which won't be forked+ -> IO b -- ^ Action which will be forked and connected with a pipe+ -> IO a -- ^ Result action+p -|- q = do+ (Just h, _, _, _) <- pipe_fork_dup q True False False+ res <- redirect stdout h p+ hClose h+ return res+++{- | Build left handed pipe of stderr.++ \"@p =|- q@\" builds an IO action from the two IO actions @p@ and @q@.+ @q@ is executed in an external process. The standard error output of @p@ is sent+ to the standard input of @q@ through a pipe. The result action consists+ of forking off @q@ (connected with a pipe), and @p@.++ The result action does /not/ run @p@ in a separate process. So, the pipe+ itself can be seen as a modified action @p@, forking a connected @q@. The+ pipe is called \"left handed\", because @p@ has this property, and not @q@.++ /The exit code of q is silently ignored./ The process ID of the forked+ copy of @q@ isn't returned to the caller, so it's lost.++ See "HsShellScript#subr" and+ "HsShellScript#exec" for further details.++ Example:++>call (exec "/usr/bin/foo" [] =|- exec "/usr/bin/bar" [])++ See 'subproc', '(-|-)', '(-|=)'.+-}+(=|-) :: IO a -- ^ Action which won't be forked+ -> IO b -- ^ Action which will be forked and connected with a pipe+ -> IO a -- ^ Result action+p =|- q = do+ (Just h, _, _, _) <- pipe_fork_dup q True False False+ res <- redirect stderr h p+ hClose h+ return res+++{- | Build right handed pipe of stdout.++ \"@p -|= q@\" builds an IO action from the two IO actions @p@ and @q@.+ @p@ is executed in an external process. The standard output of @p@ is sent+ to the standard input of @q@ through a pipe. The result action consists+ of forking off @p@ (connected with a pipe), and @q@.++ The result action does /not/ run @q@ in a separate process. So, the pipe+ itself can be seen as a modified action @q@, forking a connected @p@.+ The pipe is called \"right+ handed\", because @q@ has this property, and not @p@.++ /The exit code of p is silently ignored./ The process ID of the forked+ copy of @q@ isn't returned to the caller, so it's lost.++ See "HsShellScript#subr" and+ "HsShellScript#exec" for further details.++ Example:++ >@call (exec \"\/usr\/bin\/foo\" [] -|= exec \"\/usr\/bin\/bar\" [])@++ See 'subproc', '(=|-)', '(=|=)'.+-}+(-|=) :: IO a -- ^ Action which will be forked and connected with a pipe+ -> IO b -- ^ Action which won't be forked+ -> IO b -- ^ Result action+p -|= q = do+ (_, Just h, _, _) <- pipe_fork_dup p False True False+ res <- redirect stdin h q+ hClose h+ return res++{- | Build right handed pipe of stderr.++ \"@p =|= q@\" builds an IO action from the two IO actions @p@ and @q@.+ @p@ is executed in an external process. The standard error output of @p@ is sent+ to the standard input of @q@ through a pipe. The result action consists+ of forking off @p@ (connected with a pipe), and @q@.++ The result action does /not/ run @q@ in a separate process. So, the pipe+ itself can be seen as a modified action @q@, forking a connected @p@.+ The pipe is called \"right+ handed\", because @q@ has this property, and not @p@.++ /The exit code of p is silently ignored./ The process ID of the forked+ copy of @q@ isn't returned to the caller, so it's lost.++ See "HsShellScript#subr" and+ "HsShellScript#exec" for further details.++ Example:++ > call (exec "/usr/bin/foo" [] =|= exec "/usr/bin/bar" [])++ See 'subproc', '=|-', '-|='.+-}+(=|=) :: IO a -- ^ Action which will be forked and connected with a pipe+ -> IO b -- ^ Action which won't be forked+ -> IO b -- ^ Result action+p =|= q = do+ (_, _, Just h, _) <- pipe_fork_dup p False False True+ res <- redirect stdin h q+ hClose h+ return res+++-- | Temporarily replace a handle. This makes a backup copy of the original handle (typically a standard handle), overwrites it with the specified one,+-- runs the specified action, and restores the handle from the backup.+--+-- Example:+--+-- > h <- openFile "/tmp/log" WriteMode+-- > redirect stdout h io+-- > hClose h+--+-- This is the same as+--+-- > io ->- "/tmp/log"+--+-- See '-|-', '=|-'.+redirect :: Handle -- ^ Handle to replace+ -> Handle -- ^ Handle to replace it with+ -> IO a -- ^ Action+ -> IO a+redirect handle replacement io =+ bracket (do bak <- hDuplicate handle+ hDuplicateTo replacement handle+ return bak+ )+ (\bak -> do hDuplicateTo bak handle+ hClose bak+ )+ (\_ -> io)+++redirect_helper stdh mode io path = do+ h <- openFile path mode+ res <- redirect stdh h io+ hClose h+ return res+++{- | Redirect the standard output of the specified IO action to a file. The file will be overwritten, if it already exists.++What's actually modified is the @stdout@ handle, not the file descriptor 1. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Example:++>run "/some/program" [] ->- "/tmp/output"++Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"+IOError. (This may be a bug in the GHC 6.4 libraries). Use @->>-@ instead.++See 'subproc', 'runprog', '->>-', '=>-'.+-}+(->-) :: IO a -- ^ Action, whose output will be redirected+ -> FilePath -- ^ File to redirect the output to+ -> IO a -- ^ Result action+(->-) =+ redirect_helper stdout WriteMode+++{- | Redirect the standard output of the specified IO action to a file. If the file already exists, the output will be appended.++What's actually modified is the @stdout@ handle, not the file descriptor 1. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Example:++>run "/some/noisy/program" [] ->>- "/dev/null"++See 'subproc', 'runprog', '(->-)', '(=>>-)'.+-}+(->>-) :: IO a -- ^ Action, whose output will be redirected+ -> FilePath -- ^ File to redirect the output to+ -> IO a -- ^ Result action+(->>-) =+ redirect_helper stdout AppendMode+++{- | Redirect the standard error output of the specified IO action to a file. If the file already exists, it will be overwritten.++What's actually modified is the @stderr@ handle, not the file descriptor 2. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"+IOError. (This may be a bug in the GHC 6.4 libraries). Use @=>>-@ instead.++Example:++>run "/path/to/foo" [] =>- "/tmp/errlog"++See 'subproc', 'runprog', '(->-)', '(=>>-)'.+-}+(=>-) :: IO a -- ^ Action, whose error output will be redirected+ -> FilePath -- ^ File to redirect the error output to+ -> IO a -- ^ Result action+(=>-) =+ redirect_helper stderr WriteMode+++{- | Redirect the standard error output of the specified IO action to a file. If the file already exists, the output will be appended.++What's actually modified is the @stderr@ handle, not the file descriptor 2. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Example:++>run "/some/program" [] =>>- "/dev/null"++See 'subproc', 'runprog', '(->>-)', '(=>-)'.+-}+(=>>-) :: IO a -- ^ Action, whose error output will be redirected+ -> FilePath -- ^ File to redirect the error output to+ -> IO a -- ^ Result action+(=>>-) =+ redirect_helper stderr AppendMode+++{- | Redirect both stdout and stderr to a file. This is equivalent to the+shell's @&>@ operator. If the file already exists, it will be overwritten.++What's actually modified are the @stdout@ and @stderr@ handles, not the file+descriptors 1 and 2. The @exec@ functions know about this. See+"HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"+IOError. (This may be a bug in the GHC 6.4 libraries). Use @-&>>-@ instead.++>(-&>-) io path = err_to_out io ->- path++Example:++@call (exec \"\/path\/to\/foo\" [] -&\>- \"log\")@++See '(-&>>-)', 'err_to_out'.+-}+(-&>-) :: IO a -- ^ Action, whose output and error output will be redirected+ -> FilePath -- ^ File to redirect to+ -> IO a -- ^ Result action+(-&>-) io path = err_to_out io ->- path+++{- | Redirect both stdout and stderr to a file. If the file already exists, the+ output will be appended.++What's actually modified are the @stdout@ and @stderr@ handles, not the file+descriptors 1 and 2. The @exec@ functions know about this. See+"HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++>(-&>>-) io path = (err_to_out >> io) ->>- path++Example:++>run "/some/noisy/program" [] -&>>- "/dev/null"++See '(-&>-)', 'out_to_err'.+-}+(-&>>-) :: IO a -- ^ Action, whose output and error output will be redirected+ -> FilePath -- ^ File to redirect to+ -> IO a -- ^ Result action+(-&>>-) io path =+ err_to_out io ->>- path+++{- | Redirect stdin from a file. This modifies the specified action, such+that the standard input is read from a file.++ What's actually modified is the @stdin@ handle, not the file+ descriptor 0. The @exec@ functions know about this. See+ "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++Example:++@call (exec \"\/path\/to\/foo\" [] -\<- \"bar\")@++See 'exec', 'runprog', '(->-)', '(=>-)'.+-}+(-<-) :: IO a+ -> FilePath+ -> IO a+(-<-) = redirect_helper stdin ReadMode+++{- | Send the error output of the specified action to its standard output.++What's actually modified is the @stdout@ handle, not the file descriptor 1. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++>err_to_out = redirect stderr stdout++See 'redirect'.+-}+err_to_out :: IO a -> IO a+err_to_out = redirect stderr stdout+++{- | Send the output of the specified action to its standard error output.++What's actually modified is the @stderr@ handle, not the file descriptor 2. The+@exec@ functions know about this. See "HsShellScript#fdpipes" and+"HsShellScript#exec" for details.++>redirect stdout stderr++See 'redirect'.+-}+out_to_err :: IO a -> IO a+out_to_err = redirect stdout stderr+++-- Run an IO action as a new process, and optionally connect its+-- stdin, stdout and stderr via pipes.+pipe_fork_dup :: IO a -- Action to run in a new process.+ -> Bool -- make stdin pipe?+ -> Bool -- make stdout pipe?+ -> Bool -- make stderr pipe?+ -> IO ( Maybe Handle -- Handle to the new process's stdin, if applicable.+ , Maybe Handle -- Handle to the new process's stdout, if applicable.+ , Maybe Handle -- Handle to the new process's stderr, if applicable.+ , ProcessID+ )+pipe_fork_dup io fd0 fd1 fd2 = do+ flush_outerr++ pipe0 <- pipe_if fd0+ pipe1 <- pipe_if fd1+ pipe2 <- pipe_if fd2++ pid <- forkProcess (do -- child+ dup_close pipe0 stdin True+ dup_close pipe1 stdout False+ dup_close pipe2 stderr False+ child io+ )+ -- parent+ h0 <- finish_pipe pipe0 True+ h1 <- finish_pipe pipe1 False+ h2 <- finish_pipe pipe2 False+ return (h0, h1, h2, pid)++ where+ -- Make a pipe, if applicable.+ pipe_if False = return Nothing+ --pipe_if True = fmap Just $ createPipe -- Just (read,write)+ pipe_if True = do+ (read, write) <- createPipe+ return (Just (read,write))++ -- Child work after fork: connect a fd of the new process to the pipe.+ dup_close :: Maybe (Fd, Fd) -- maybe the pipe+ -> Handle -- which handle descriptor to connect to the pipe+ -> Bool -- whether the child reads from this pipe+ -> IO ()+ dup_close Nothing _ _ =+ return ()+ dup_close m@(Just (readend,writeend)) dest True =+ do+ h <- System.Posix.fdToHandle readend+ hDuplicateTo h dest+ hClose h+ closeFd writeend+ dup_close m@(Just (readend,writeend)) dest False =+ do h <- System.Posix.fdToHandle writeend+ hDuplicateTo h dest+ hClose h+ closeFd readend++ -- Parent work after fork: close surplus end of the pipe and make a handle from the other end.+ finish_pipe :: Maybe (Fd, Fd) -- maybe the pipe+ -> Bool -- whether the fd is for reading+ -> IO (Maybe Handle)+ finish_pipe Nothing _ =+ return Nothing+ finish_pipe (Just (readend,writeend)) read =+ do closeFd (if read then readend else writeend)+ let fd = if read then writeend else readend+ h <- System.Posix.fdToHandle fd+ return (Just h)+++-- | Run an IO action as a separate process, and pipe some text to its @stdin@.+-- Then close the pipe and wait for the child process to finish. If it+-- exits in a way which indicates an error, the @ProcessStatus@ is thrown.+--+-- Example: @pipe_to \"blah\" $ exec \"\/usr\/bin\/foo\" [\"bar\"]@+--+-- See 'subproc', 'runprog', '-<-', 'h_pipe_to'. See "HsShellScript#fdpipes" for more details.+pipe_to :: String -- ^ Text to pipe+ -> IO a -- ^ Action to run as a separate process, and to pipe to+ -> IO ()+pipe_to str io = do+ (h, pid) <- h_pipe_to io+ hPutStr h str+ hClose h+ (Just ps) <- getProcessStatus True False pid+ if ps == Exited ExitSuccess+ then return ()+ else throw ps+++-- | Run an IO action as a separate process, and connect to its @stdin@+-- with a pipe.+--+-- Example: @h \<- h_pipe_to $ exec \"\/usr\/bin\/foo\" [\"bar\"]@+--+-- See '-<-', 'pipe_to', 'pipe_from', 'pipe_from2'. See "HsShellScript#fdpipes" for more details.+h_pipe_to :: IO a -- ^ Action to run as a separate process, and to pipe to+ -> IO (Handle, ProcessID) -- ^ Returns handle connected to the standard input of the child process, and the child's process ID+h_pipe_to io = do+ (Just h, _, _, pid) <- pipe_fork_dup io True False False+ return (h, pid)+++-- | Run an IO action as a separate process, and read its @stdout@+-- strictly. Then wait for the child process to finish. This is like the+-- backquote feature of shells.+--+-- If the child process exits with a non-zero exit code, the+-- @ProcessStatus@ is thrown.+--+-- The whole output is returned, no trailing newline character is removed, like the shell does with backquotes. You may want to apply @chomp@+-- to the result.+--+-- Example:+--+-- >output <- pipe_from $ exec "/bin/foo" ["bar"]+--+-- See 'exec', 'pipe_to', 'pipe_from2', 'h_pipe_from', 'lazy_pipe_from', 'chomp', 'silently'. See "HsShellScript#fdpipes" for more details.+pipe_from :: IO a -- ^ Action to run as a separate process+ -> IO String -- ^ The called program's standard output+pipe_from io = do+ (h, pid) <- h_pipe_from io+ txt <- hGetContents h+ seq (length txt) (hClose h)+ (Just ps) <- getProcessStatus True False pid+ if ps == Exited ExitSuccess+ then return txt+ else throw ps+++-- | Run an IO action as a separate process, and read its @stderr@+-- strictly. Then wait for the child process to finish, and return the text+-- along with its exit code.+--+-- Example:+--+-- >(errmsg, ec) <- pipe_from2 $ exec "/bin/foo" ["bar"] ->- "/dev/null"+-- >+-- >when (ec /= Exited ExitSuccess) $ do+-- > errm errmsg+-- > ...+--+-- See 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from2', 'lazy_pipe_from2', 'silently'. See "HsShellScript#fdpipes" for more details.+pipe_from2 :: IO a -- ^ Action to run as a separate process+ -> IO (String, ProcessStatus) -- ^ The called program's standard output+pipe_from2 io = do+ (h, pid) <- h_pipe_from2 io+ txt <- hGetContents h+ seq (length txt) (hClose h)+ (Just ps) <- getProcessStatus True False pid+ return (txt, ps)+++-- | Run an IO action as a separate process, and connect to its @stdout@+-- with a pipe.+--+-- A handle connected to the child process, and the process ID+-- of the child are returned. The process ID can be used with+-- @System.Posix.getProcessStatus@ to get the child's exit code. You must either+-- ensure that all data has been read, or close the handle, before calling+-- @getProcessStatus@ blockingly. Otherwise you'll get a deadlock. When you+-- close the handle before all data has been read, then the child gets a+-- @SIGPIPE@ signal.+--+-- Example:+--+-- >h <- h_pipe_from $ exec "/usr/bin/foo" ["bar"]+--+-- See 'exec', 'pipe_to', 'h_pipe_from2', 'pipe_from', 'lazy_pipe_from', 'chomp', 'silently'. See "HsShellScript#fdpipes" for more details.+h_pipe_from :: IO a -- ^ Action to run as a separate process, and to pipe from+ -> IO (Handle, ProcessID) -- ^ Returns handle connected to the standard output of the child process, and the child's process ID+h_pipe_from io = do+ (_, Just h, _, pid) <- pipe_fork_dup io False True False+ return (h, pid)+++-- | Run an IO action as a separate process, and connect to its @stderr@+-- with a pipe.+--+-- A handle connected to the child process' standard error output, and the process ID+-- of the child are returned. The process ID can be used with+-- @System.Posix.getProcessStatus@ to get the child's exit code. You must either+-- ensure that all data has been read, or close the handle, before calling+-- @getProcessStatus@ blockingly. Otherwise you'll get a deadlock. When you+-- close the handle before all data has been read, then the child gets a+-- @SIGPIPE@ signal. Of course, you can also use the process ID to kill the+-- child process.+--+-- Example:+--+-- >h <- h_pipe_from2 $ exec "/usr/bin/foo" ["bar"]+--+-- See 'exec', 'pipe_to', 'h_pipe_from', 'pipe_from2', 'lazy_pipe_from2', 'chomp', 'silently'. See "HsShellScript#fdpipes" for more details.+h_pipe_from2 :: IO a -- ^ Action to run as a separate process, and to pipe from+ -> IO (Handle, ProcessID) -- ^ Returns handle connected to the standard output of the child process, and the child's process ID+h_pipe_from2 io = do+ (_, _, Just h, pid) <- pipe_fork_dup io False False True+ return (h, pid)+++-- | Run an IO action as a separate process, and read its @stdout@,+-- This is like the backquote feature of shells. The output is read+-- lazily, as the returned string is evaluated.+--+-- The child's output along with its process ID are returned. The process ID can+-- be used with @System.Posix.getProcessStatus@ to get the child process' exit+-- code. Be aware that you must evaluate the whole string, before calling+-- @getProcessStatus@ blockingly, or you'll get a deadlock.+--+-- The whole output is returned, no trailing newline character is removed, like+-- the shell does with backquotes. You'll possibly want to apply 'chomp' to the+-- result.+--+-- Example:+--+-- >(txt, pid) <- lazy_pipe_from $ exec "/usr/bin/foo" ["bar"]+-- >...+-- >-- Done, but must read the rest of the output+-- >seq (length txt) (return ())+-- >(Just ps) <- getProcessStatus True False pid+--+-- See 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from', 'lazy_pipe_from2', 'silently'. See "HsShellScript#fdpipes" for more details.+lazy_pipe_from :: IO a -- ^ Action to run as a separate process+ -> IO (String, ProcessID) -- ^ The action's lazy output and the process ID of the child process+lazy_pipe_from io = do+ (_, Just h, _, pid) <- pipe_fork_dup io False True False+ txt <- hGetContents h+ return (txt, pid)+++-- | Run an IO action as a separate process, and read its @stderr@. The output+-- is read lazily, as the returned string is evaluated.+--+-- The child's error output along with its process ID are returned. The process+-- ID can be used with @System.Posix.getProcessStatus@ to get the child process'+-- exit code. Be aware that you must evaluate the whole string, before calling+-- @getProcessStatus@ blockingly, or you'll get a deadlock.+--+-- Example:+--+-- >(errmsg, pid) <- lazy_pipe_from2 $ exec "/usr/bin/foo" ["bar"] ->- "/dev/null"+-- >...+-- >-- Read enough error messages, terminate the child.+-- >signalProcess killProcess pid+-- >+-- >-- Make sure the file descriptor gets closed, or you may run out of file descriptors.+-- >seq (length errmsg) (return ())+--+-- See 'exec', 'pipe_to', 'pipe_from2', 'h_pipe_from2', 'lazy_pipe_from', 'silently'. See "HsShellScript#fdpipes" for more details.+lazy_pipe_from2 :: IO a -- ^ Action to run as a separate process+ -> IO (String, ProcessID) -- ^ The action's lazy output and the process ID of the child process+lazy_pipe_from2 io = do+ (_, Just h, _, pid) <- pipe_fork_dup io False True False+ txt <- hGetContents h+ return (txt, pid)+++-- | Run an IO action as a separate process, and optionally connect to its+-- @stdin@, its @stdout@ and its @stderr@ output with+-- pipes.+--+-- See 'pipe_from', 'pipe_from2', 'pipe_to'.+pipes :: IO a -- ^ Action to run in a new process+ -> Bool -- ^ Whether to make stdin pipe+ -> Bool -- ^ Whether to make stdout pipe+ -> Bool -- ^ Whether to make stderr pipe+ -> IO ( Maybe Handle+ , Maybe Handle+ , Maybe Handle+ , ProcessID+ ) -- ^ Pipes to the new process's @stdin@, @stdout@ and @stderr@, if applicable; and its process id.+pipes = pipe_fork_dup+++-- {- | Execute the supplied action. In case of an error, exit with an error+-- message.+--+-- > Noch nicht auf neue Exception-Bibliothek portiert. <+--+-- An error is an exception, thrown using @throw@ as a type which is+-- instance of @Typeable@. The type err is supposed to be a specific type used+-- for specific errors. The program is terminated with @exitFailure@.+-- -}+-- abort :: Exception err+-- => (err -> String) -- ^ Error message generation function+-- -> IO a -- ^ IO action to monitor+-- -> IO a -- ^ Same action, but abort with error message in case of user exception+-- abort msgf io =+-- io+-- `catch` (\se -> hPutStrLn stderr (msgf errval) >> exitFailure)+++{- | Forcibly terminate the program, circumventing normal program shutdown.++This is the @_exit(2)@ system call. No cleanup actions installed with @bracket@+are performed, no data buffered by file handles is written out, etc.+-}+_exit :: Int -- ^ Exit code+ -> IO a -- ^ Never returns+_exit ec = do+ {#call _exit as _exit_prim#} (fromIntegral ec)+ error "Impossible error" -- never reached, only for the type checker++++-- | Generate an error message from an @errno@ value. This is the POSIX+-- @strerror@ system library function.+--+-- See the man page @strerror(3)@.+strerror :: Errno -- ^ @errno@ value+ -> IO String -- ^ Corresponding error message+strerror (Errno errno) = do+ peekCString ({#call pure strerror as foreign_strerror#} errno)+++-- | Read the global system error number. This is the POSIX @errno@ value. This+-- function is redundant. Use @Foreign.C.Error.getErrno@ instead.+errno :: IO Errno -- ^ @errno@ value+errno = getErrno+++-- | Print error message corresponding to the specified @errno@ error+-- number. This is similar to the POSIX system library function @perror@.+--+-- See the man page @perror(3)@.+perror' :: Errno -- ^ @errno@ error number+ -> String -- ^ Text to precede the message, separated by \"@: @\"+ -> IO ()+perror' errno txt = do+ str <- strerror errno+ hPutStrLn stderr ((if txt == "" then "" else txt ++ ": ") ++ str)+++-- | Print error message corresponding to the global @errno@ error+-- number. This is the same as the POSIX system library function @perror@.+--+-- See the man page @perror(3)@.+perror :: String -- ^ Text to precede the message, separated by \"@: @\"+ -> IO ()+perror txt = do+ eno <- getErrno+ perror' eno txt+++-- | Print a message to @stderr@ and exit with an exit code+-- indicating an error.+--+-- >failIO msg = hPutStrLn stderr msg >> exitFailure+failIO :: String -> IO a+failIO meld =+ hPutStrLn stderr meld >> exitFailure+++-- | Modify an IO action to return the exit code of a failed program call,+-- instead of throwing an exception.+--+-- This is used to modify the error reporting behaviour of an IO action which+-- uses 'run'/'runprog' or 'call'/'subproc'. When an external program exits with+-- an exit code which indicates an error, normally an exception is thrown. After+-- @exitcode@ has been applied, the exit code is retruned instead.+--+-- The caught exceptions are 'RunError' and 'ProcessStatus'. Termination by a+-- signal is still reported by an exception, which is passed through.+--+-- Example: @ec \<- exitcode $ runprog \"foo\" [\"bar\"]@+--+-- See 'runprog', 'subproc', 'run', 'call'.+exitcode :: IO () -- ^ Action to modify+ -> IO ExitCode -- ^ Modified action+exitcode io =+ do io+ return ExitSuccess+ `catch`+ (\processstatus ->+ case processstatus of+ (Exited ec) -> return ec+ ps -> throw ps)+ `catch`+ (\re ->+ case re_ps re of+ (Exited ec) -> return ec+ ps -> throw re)+++-- |Create and throw an @IOError@ from the current @errno@ value, an optional handle and an optional file name.+--+-- This is an extended version of the @Foreign.C.Error.throwErrno@ function+-- from the GHC libraries, which additionally allows to specify a handle and a file+-- name to include in the @IOError@ thrown.+--+-- See @Foreign.C.Error.throwErrno@, @Foreign.C.Error.errnoToIOError@.+throwErrno' :: String -- ^ Description of the location where the error occurs in the program+ -> Maybe Handle -- ^ Optional handle+ -> Maybe FilePath -- ^ Optional file name (for failing operations on files)+ -> IO a+throwErrno' loc maybe_handle maybe_filename =+ do+ errno <- getErrno+ ioError (errnoToIOError loc errno maybe_handle maybe_filename)+++-- |Convert an @IOError@ to a string.+--+-- There is an instance declaration of @IOError@ in @Show@ in the @GHC.IO@ library, but @show_ioerror@ produces a more readable, and more+-- complete, message.+show_ioerror :: IOError -> String+show_ioerror ioe =+ "IO-Error\n\+ \ Error type: " ++ show (ioeGetErrorType ioe) ++ "\n\+ \ Location: " ++ none (indent (ioe_location ioe)) ++ "\n\+ \ Description: " ++ none (indent (ioe_description ioe)) ++ "\n\+ \ " ++ fn (ioeGetFileName ioe)+ where fn (Just n) = "File name: " ++ quote n+ fn Nothing = "File name: (none)"+ none "" = "(none)"+ none msg = msg+ indent txt = concat (intersperse ("\n ") (lines txt))+++{- |+ Call the shell to execute a command. In case of an error, throw the @ProcessStatus@ (such as @(Exited (ExitFailure ec))@) as an exception.+ This is like the Haskell standard library function @system@, except that error handling is brought in accordance with HsShellScript\'s scheme.++ @exitcode . system_throw@ is the same as the @system@ function, except that when the called shell is terminated or stopped by a signal, this still+ lead to the @ProcessStatus@ being thrown. The Haskell library report says nothing about what happens in this case, when using the+ @system@ function.++>system_throw cmd = run "/bin/sh" ["-c", "--", cmd]++ This function is deprecated. You should rather use 'system_runprog', which provides for much better error reporting.+-}+-- This function should go to HsShellScript.Shell, but this would introduce a circular dependency.+system_throw :: String -> IO ()+system_throw cmd =+ run "/bin/sh" ["-c", "--", cmd]+++++{- |+ Call the shell to execute a command. In case of an error, a @RunError@ ist thrown.+ This is like the Haskell standard library function @system@, except that error handling is brought in accordance with HsShellScript's scheme. (It is+ /not/ a front end to @system@.)++>system_runprog cmd = runprog "/bin/sh" ["-c", "--", cmd]++ Example: Call \"foo\" and report Errors as @IOError@s, rather than @RunError@s.++>as_ioe $ system_runprog "foo" ["bar", "baz"]++ See 'RunError', 'as_ioe'+-}+-- This function should go to HsShellScript.Shell, but this would introduce a circular dependency.+system_runprog :: String -> IO ()+system_runprog cmd =+ runprog "/bin/sh" ["-c", "--", cmd]++++{- | Run a subroutine as a child process, but don't let it produce any messages.+Read its @stdout@ and @stderr@ instead, and append it to the contents of a+mutable variable. The idea is that you can run some commands silently, and+report them and their messages to the user only when something goes wrong.++If the child process terminates in a way which indicates an error, then the+process status is thrown, in the same way as 'runprog' does. If the subroutine+throws an @(Exited ec)@ exception (of type @ProcessStatus@), such as thrown by+'runprog', then the child process exits with the same exit code, such that the+parent process reports it to the caller, again as a @ProcessStatus@ exception.++When the subroutine finishes, the child process is terminated with @'_exit' 0@.+When it throws an exception, an error message is printed and it is terminated+with @'_exit' 1@. See "HsShellScript#subr" for details.++The standard output (and the standard error output) of the parent process are+flushed before the fork, such that no output appears twice.++Example:++>let handler :: IORef String -> ProcessStatus -> IO ()+> handler msgref ps = do hPutStrLn stderr ("Command failed with " ++ show ps ++ ". Actions so far: ")+> msg <- readIORef msgref+> hPutStrLn stderr msg+> exitWith (ExitFailure 1)+>+>msgref <- newIORef ""+>do silently msgref $ do putStrLn "Now doing foobar:"+> echo exec "/foo/bar" ["arguments"]+> silently msgref $ echo exec "/bar/baz" ["arguments"]+>`catch` (handler msgref)++See 'lazy_pipe_from', 'subproc', 'runprog', Data.IORef.+-}+silently :: IORef.IORef String -- ^ A mutable variable, which gets the output (stdout and stderr) of the action appended.+ -> IO () -- ^ The IO action to run.+ -> IO ()+silently ref io = do+ (msg, pid) <- lazy_pipe_from (err_to_out (child io))+ seq (length msg) (return ())++ msgs <- readIORef ref+ writeIORef ref (msgs ++ msg)++ (Just ps) <- getProcessStatus True False pid+ case ps of+ Exited ExitSuccess -> return ()+ ps -> throw ps+++{- | Modify a subroutine action in order to make it suitable to run as a child+ process.++ This is used by functions like 'call', 'silently', 'pipe_to' etc. The action+ is executed. When it returns, the (child) process is terminated with @'_exit' 0@+ (after flushing @stdout@), circumventing normal program shutdown. When it+ throws an exception, an error message is printed and the (child) process is+ terminated with @'_exit' 1@.+-}+child :: IO a -- Action to modify+ -> IO b -- Never returns+child io = do+ (io `finally` flush_outerr)+ `catches` + [ Handler $ (\argerror -> do+ errm $ "In child process:\n" ++ argerror_message argerror+ _exit 1+ )+ , Handler $ (\processstatus -> do+ errm $ "Process error in child process. Process status = " ++ show ( processstatus :: ProcessStatus )+ _exit 1+ )+ , Handler $ (\(ioe::IOError) -> do+ errm ("In child process:\n " ++ show_ioerror ioe)+ _exit 1+ )+ , Handler $ (\(e::ExitCode) -> do + -- Child process is a subroutine that has terminated normally.+ errm "Warning! Child process tries to shut down normally. This is a bug. It should\n\+ \terminate with _exit (or catch the ExitException yourself). See section\n\"\+ \Running a Subroutine in a Separate Process\" in the HsShellScript API\n\+ \documentation. Terminating with _exit 0 now."+ _exit (case e of+ ExitSuccess -> 0+ ExitFailure ec' -> ec'+ ))+ , Handler $ (\(e::SomeException) -> do+ errm ("Child process quit with unexpected exception:\n" ++ show e)+ _exit 1+ )+ ]++ _exit 0+++{- | Print text to @stdout@.++ This is a shorthand for @putStrLn@, except for @stderr@ being flushed+ beforehand. This way normal output and error output appear in+ order, even when they aren't buffered as by default.++ An additional newline is printed at the end.++ >outm msg = do+ > hFlush stderr+ > putStrLn msg+-}+outm :: String -- ^ Message to print+ -> IO ()+outm msg = do+ hFlush stderr+ putStrLn msg+++{- | Print text to @stdout@.++ This is a shorthand for @putStr@, except for @stderr@ being flushed+ beforehand. This way normal output and error output appear in+ order, even when they aren't buffered as by default.++ No newline is printed at the end.++ >outm_ msg = do+ > hFlush stderr+ > putStr msg+-}+outm_ :: String -- ^ Message to print+ -> IO ()+outm_ msg = do+ hFlush stderr+ putStr msg+++{- | Colorful log message to @stderr@.++ This prints a message to @stderr@. When @stderr@ is connected to a terminal+ (as determined by @isatty(3)@), additional escape sequences are printed,+ which make the message appear in cyan. Additionally, a newline character is+ output at the end.++ @stdout@ is flushed beforehand. So normal output and error output appear in+ order, even when they aren't buffered as by default.++ See 'logm_', 'errm', 'errm_'.+-}+logm :: String -- ^ Message to print+ -> IO ()+logm msg =+ do hFlush stdout+ tty <- isatty stderr+ if tty+ then hPutStrLn stderr $ "\ESC[36m" ++ msg ++ "\ESC[00m"+ else hPutStrLn stderr msg+++{- | Colorful log message to @stderr@.++ This prints a message to @stderr@. When @stderr@ is connected to a terminal+ (as determined by @isatty(3)@), additional escape sequences are printed,+ which make the message appear in cyan. No a newline character is output at the end.++ @stdout@ is flushed beforehand. So normal output and error output appear in+ order, even when they aren't buffered as by default.++ See 'logm', 'errm', 'errm_'.+-}+logm_ :: String -> IO ()+logm_ msg = do+ do hFlush stdout+ tty <- isatty stderr+ if tty+ then hPutStr stderr $ "\ESC[36m" ++ msg ++ "\ESC[00m"+ else hPutStr stderr msg+++{- | Colorful error message to @stderr@.++ This prints a message to @stderr@. When @stderr@ is connected to a terminal+ (as determined by @isatty(3)@), additional escape sequences are printed,+ which make the message appear in red. Additionally, a newline character is+ output at the end.++ @stdout@ is flushed beforehand. So normal output and error output appear in+ order, even when they aren't buffered as by default.++ See 'logm', 'logm_', 'errm_'.+-}+errm :: String -> IO ()+errm msg = do+ do hFlush stdout+ tty <- isatty stderr+ if tty+ then hPutStrLn stderr $ "\ESC[01;31m" ++ msg ++ "\ESC[00m"+ else hPutStrLn stderr msg+++{- | Colorful error message to @stderr@.++ This prints a message to @stderr@. When @stderr@ is connected to a terminal+ (as determined by @isatty(3)@), additional escape sequences are printed,+ which make the message appear in red. No a newline character is output at the end.++ @stdout@ is flushed beforehand. So normal output and error output appear in+ order, even when they aren't buffered as by default.++ See 'logm', 'logm_', 'errm'.+-}+errm_ :: String -> IO ()+errm_ msg = do+ do hFlush stdout+ tty <- isatty stderr+ if tty+ then hPutStr stderr $ "\ESC[01;31m" ++ msg ++ "\ESC[00m"+ else hPutStr stderr msg+++{- | In case the specified action throws an IOError, fill in its filename field. This way, more useful error messages can be produced.++Example:++>-- Oh, the GHC libraries neglect to fill in the file name+>executeFile' prog a b c =+> fill_in_filename prog $ executeFile prog a b c++See 'fill_in_location', 'add_location'.+-}+fill_in_filename :: String -- ^ File name to fill in+ -> IO a -- ^ IO action to modify+ -> IO a -- ^ Modified IO action+fill_in_filename filename io =+ io `catch` (\ioe -> ioError (ioeSetFileName ioe filename))+++{- | In case the specified action throws an IOError, fill in its location field. This way, more useful error messages can be produced.++Example:++>my_fun a b c = do+> -- ...+> fill_in_location "my_fun" $ -- Give the caller a more useful location information in case of failure+> rename "foo" "bar"+> -- ...++See 'fill_in_filename'.+-}+fill_in_location :: String -- ^ Location name to fill in+ -> IO a -- ^ IO action to modify+ -> IO a -- ^ Modified IO action+fill_in_location location io =+ io `catch` (\ioe -> ioError (ioeSetLocation ioe location))+++{- | In case the specified action throws an IOError, add a line to its location field. This way, more useful error messages can be produced. The+ specified string is prepended to the old location, separating it with a newline from the previous location, if any. When using this thoroughly, you+ get a reverse call stack in IOErrors.++Example:++>my_fun =+> add_location "my_fun" $ do+> -- ...++See 'fill_in_filename', 'fill_in_location'.+-}+add_location :: String -- ^ Location name to add+ -> IO a -- ^ IO action to modify+ -> IO a -- ^ Modified IO action+add_location location io =+ io `catch` (\ioe -> let loc = case ioe_location ioe of+ "" -> location+ loc0 -> location ++ "\n" ++ loc0+ in ioError (ioe { ioe_location = loc })+ )+++{- | This is a replacement for @System.Posix.Process.executeFile@. It does+ additional preparations, then calls @executeFile@. @executeFile@ /can't normally/+ /be used directly, because it doesn't do the things which are/+ /outlined here./++ This are the differences to @executeFile@:++ 1. @stdout@ and @stderr@ are flushed.++ 2. The standard file descriptors 0-2 are made copies of the file descriptors+ which the standard handles currently use. This is necessary because they+ might no longer use the standard handles. See "HsShellScript#fdpipes".++ If the standard handles @stdin@, @stdout@, @stderr@ aren't in closed state,+ and they aren't already connected to the respective standard file+ descriptors, their file descriptors are copied to the respective standard+ file descriptors (with @dup2@). Backup copies are made of the file+ descriptors which are overwritten. If some of the standard handles are closed,+ the corresponding standard file descriptors are closed as well.++ 3. All file descriptors, except for the standard ones, are set to close-on-exec+ (see @fcntl(2)@), and will be closed on successful replacement of+ the process. Before that, the old file descriptor flags are saved.++ 4. The standard file descriptors are set to blocking mode, since GHC 6.2.2+ sets file descriptors to non-blocking (except 0-2, which may get+ overwritten by a non-blocking one in step 2). The called program+ doesn't expect that.++ 5. In case replacing the process fails, the file descriptors are reset to+ the original state. The file descriptors flags are restored, and the file+ descriptors 0-2 are overwritten again, with their backup copies. Then an+ IOError is thrown.++ 6. In any IOError, the program is filled in as the file name (@executeFile@+ neglects this).++ 7. The return type is a generic @a@, rather than @()@.++ Also see "HsShellScript#exec".+-}+execute_file :: FilePath -- ^ Program to call+ -> Bool -- ^ Search @PATH@?+ -> [String] -- ^ Arguments+ -> Maybe [(String, String)] -- ^ Optionally new environment+ -> IO a -- ^ Never returns+execute_file path search args menv =+ fill_in_filename path $ fill_in_location "execute_file" $ do+ bracket+ (do -- Flush stdout and stderr, if open+ flush_outerr++ -- Make fds 0-2 copies of the things which the standard handles refer to.+ recover0 <- restore stdin 0+ recover1 <- restore stdout 1+ recover2 <- restore stderr 2++ -- Save the flags of all file descriptors+ fdflags <- {# call c_save_fdflags #}++ -- Prepare all fds for subsequent exec. Fds 0-2 are set to blocking (because GHC sets new fds to non-blocking). All+ -- others are set to close-on-exec.+ {# call c_prepare_fd_flags_for_exec #}++ return (recover0, recover1, recover2, fdflags)+ )+ (\(recover0, recover1, recover2, fdflags) ->+ do -- Failure of the exec. Restore the file descriptor flags+ {# call c_restore_fdflags #} fdflags++ -- Restore the standard handles+ recover0+ recover1+ recover2+ )+ (const $ do+ -- The exec. Throws an IOError in case replacing the process failed.+ executeFile path search args menv++ -- Never reached, only for the type checker+ error "Impossible error"+ )++ where+ handleToFd_noclose :: Handle -> IO Fd+ handleToFd_noclose h =+ unsafeWithHandleFd h (\fd -> return fd)++ restore h@(FileHandle _ mvar) fd = do+ -- The fd used by the handle. This is in GHC.IO.Handle.FD+ -- handleToFd_noclose: Fehlerhaft, aus hssh-2.9+ -- handle_fd: der file descriptor, den der Handle mitbringt. Weicht möglicherweise von 0-2 ab.+ handle_fd <- fmap fromIntegral (handleToFd_noclose h)++ -- Get the fd which the handle h uses. This locks the handle.+ (h__ :: Handle__) <- takeMVar mvar++ -- Make a copy of the fd which is about to be overwritten. Returns -1 for invalid (closed) fd.+ -- Mache Sicherheitskopie des Standard-file descriptor (0-2) in einem neu zu belegenden f.d. (ab 3).+ -- fd: Standard-file descritor, 0-2.+ -- Bewegt den Standardfiledescriptor aus dem Weg.+ fd_backup <- {# call c_fcntl_dupfd #} fd 3+ -- Liefert den neuen file descriptor, oder -1 (bei Fehler), wenn der filedescriptor geschlossen ist+++ -- Is the handle closed?+ let closed = case haType h__ of+ ClosedHandle -> True+ SemiClosedHandle -> True+ otherwise -> False++ -- If the handle is open, make the fd a copy of the fd which the handle uses. Otherwise, close the fd as well.+ if closed+ then {# call close #} fd >> return ()+ else when (fd /= handle_fd) $+ -- Den f.d., den der Standard-Handle benutzt, auf die Standardposition in 0-2 kopieren.+ {# call dup2 #} handle_fd fd >> return ()+++ -- Return recovery action which undoes everything.+ return (do -- Restore the fd+ if fd_backup /= -1 then do -- Den Inhalt des 0-2-file descriptors wiederherstellen+ {# call dup2 #} fd_backup fd+ -- Die Sicherheitskopie wieder freigeben+ {# call close #} fd_backup++ return ()+ else do -- Wenn der 0-2-filedescriptor nicht kopiert werden konnte, dann liegt das (?) daran, daß er+ -- geschlossen war. Ihn dann wieder schließen.+ {# call close #} fd+ return ()+ -- Unlock the handle+ putMVar mvar h__+ return ()+ )++ -- Silly: The standard handle has been overwritten with a duplex.+ restore h fd = do+ -- Make a copy of the fd which is about to be closed. Returns -1 for already closed fd.+ fd_backup <- {# call c_fcntl_dupfd #} fd 3++ -- Close the fd+ {# call close #} fd++ -- Return recovery action, which restores the fd.+ return (if fd_backup /= -1 then do {# call dup2 #} fd_backup fd+ {# call close #} fd_backup+ return ()+ else do {# call close #} fd+ return ()+ )++++{- About Bas van Dijk's unsafeWithHandleFd:++ This function is broken. It blocks when called like this:++ -- Blocks+ unsafeWithHandleFd stdout $ \fd ->+ putStrLn ("stdout: fd = " ++ show fd)++ The job of unsafeWithHandleFd's job is, to keep a reference to+ the handle, so it won't be garbage collected, while the action is still+ running. Garbage collecting the handle would close it, as well as the+ underlying file descriptor, while the latter is still in use by the action.+ This can't happen as long as use of the file descriptor is encapsulated in the+ action.++ This encapsulation can be circumvented by returning the file descriptor, and+ that's what I do in execute_file. This should usually not be done.++ However, I want to use it on stdin, stdout and stderr, only. These three+ should never be garbage collected. Under this circumstances, it should be+ safe to use unsafeWithHandleFd this way.+-}++unsafeWithHandleFd :: Handle -> (Fd -> IO a) -> IO a+unsafeWithHandleFd h@(FileHandle _ m) f = unsafeWithHandleFd' h m f+-- unsafeWithHandleFd h@(DuplexHandle _ _ w) f = unsafeWithHandleFd' h w f++unsafeWithHandleFd' :: Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a+unsafeWithHandleFd' h m f =+ withHandle' "unsafeWithHandleFd" h m $ \h_@Handle__{haDevice} ->+ case cast haDevice of+ Nothing -> ioError (System.IO.Error.ioeSetErrorString (System.IO.Error.mkIOError IllegalOperation "unsafeWithHandleFd" (Just h) Nothing)+ "handle is not a file descriptor")+ Just fd -> do+ x <- f (Fd (FD.fdFD fd))+ return (h_, x)+++------------------------------------------------------------------------------------------------------------------------------------------------------++++{- | Check if a handle is connected to a terminal.++ This is a front end to the @isatty(3)@ function (see man page). It is useful,+ for instance, to determine if color escape sequences should be+ generated.+-}++isatty :: Handle -- ^ Handle to check+ -> IO Bool -- ^ Whether the handle is connected to a terminal+isatty h =+ unsafeWithHandleFd h $ \fd -> do+ isterm <- {# call isatty as hssh_c_isatty #} ((fromIntegral fd) :: CInt)+ return (isterm /= (0::CInt))+++-- Flush stdout and stderr (which should not be necessary). Discard Illegal Operation IOError which arises when they are closed.+flush_outerr = do+ flush stdout+ flush stderr+ where+ flush h = hFlush h `catch` (\ioe -> if isIllegalOperation ioe then return () else ioError ioe)+++-- ProcessStatus doesn't derive Typeable.+{-+data ProcessStatus = Exited ExitCode+ | Terminated Signal+ | Stopped Signal+ deriving (Eq, Ord, Show)+-}+instance Typeable ProcessStatus where+ typeOf = const tyCon_ProcessStatus++-- GHC 6.4+tyCon_ProcessStatus = mkTyConApp (mkTyCon3 "hsshellscript" + "HsShellScript.ProcErr"+ "Posix.ProcessStatus") []+++-- | The GHC libraries don't declare @Foreign.C.Error.Errno@ as instance of+-- Show. This makes it up.+instance Show Foreign.C.Error.Errno where+ show (Errno e) = show e+++++------------------------------------------------------------------------------------------------------------------------------------------------------+-- Transmission of at most one IOError through a pipe (as far as that's possible).+-- This is used by execute_file to send the IOError of a failed exec...-call to the parent process.+--+-- Can't be transmitted:+-- - the handle field (of course...)+-- - IOErrors of the type DynIOError. They carry a dynamic value, with no provisions for serialization.+--+-- See base.GHC.IO.lhs+++-- Read a single possible IOError from a file descriptor. The stream must be+-- closed on the other side after writing either nothing or a single IOError to+-- it.+receive_ioerror :: Fd -> IO (Maybe IOError)+receive_ioerror fd = do+ h <- System.Posix.fdToHandle fd+ txt <- hGetContents h+ seq (length txt) (return ())+ hClose h+ return (decode_ioerror txt)+++-- Write a single IOError to a file descriptor, and close it.+send_ioerror fd ioe = do+ h <- System.Posix.fdToHandle fd+ Foreign.C.Error.getErrno+ hPutStr h (encode_ioerror ioe)+ hClose h+++encode_ioerror :: IOError -> String+encode_ioerror ioe =+ show (ioetype_num ioe, ioe_location ioe, ioe_description ioe, ioe_filename ioe, ioe_errno ioe)+++decode_ioerror :: String -> Maybe IOError+decode_ioerror txt =+ case txt of+ "" -> Nothing+ _ -> let (type_nr, location, description, filename, errno) = read txt+ in (Just (IOError { ioe_handle = Nothing,+ ioe_type = num_ioetype type_nr,+ ioe_location = location,+ ioe_description = description,+ ioe_filename = filename,+ ioe_errno = errno+ }))++-- All IOError types in GHC 6.4, taken from the source code of GHC.IO.+-- Used only for serializing IOErrors which are thrown by executeFile, so this should never go out of date.+ioe_types = [(AlreadyExists, 1), (NoSuchThing, 2), (ResourceBusy, 3), (ResourceExhausted, 4), (EOF, 5), (IllegalOperation, 6), (PermissionDenied, 7),+ (UserError, 8), (UnsatisfiedConstraints, 9), (SystemError, 10), (ProtocolError, 11), (OtherError, 12), (InvalidArgument, 13),+ (InappropriateType, 14), (HardwareFault, 15), (UnsupportedOperation, 16), (TimeExpired, 17), (ResourceVanished, 18), (Interrupted, 19)]++-- IOError type as a number+ioetype_num ioe =+ case ioeGetErrorType ioe of+ ioetype -> case lookup ioetype ioe_types of+ Just num -> num+ Nothing -> error "Bug in HsShellScript: Unknown IOError type, can't serialize it."++-- IOError type from the number+num_ioetype num =+ case lookup num (map (\(a,b) -> (b,a)) ioe_types) of+ Just ioetype -> ioetype+ Nothing -> error ("Bug in HsShellScript: Unknown IOError type number " ++ show num)+++instance Exception ProcessStatus++++{- ALT:++------------------------------------------------------------------------------------------------------------------------------------------------------+-- Getting the file descriptor which is encapsulated inside a handle+++-- This is a modified version of System.Posix.IO.handleToFd. The original function has the side effect of closing the handle. From the GHC+-- documentation:+--+-- "converting a Handle into an Fd effectively means+-- letting go of the Handle; it is put into a closed+-- state as a result."+--+-- The modified version does the same, but doesn't close the handle.++handleToFd_noclose :: Handle -- Handle, must be a @FileHandle@. Throws an @IOError@ when the handle is a @DuplexHandle@, or when the+ -- handle doesn't incapsulate a file descriptor.+ -> IO Fd -- The file descriptor inside of the handle.++handleToFd_noclose h@(FileHandle _ m) = do+ withHandle' "handleToFd_noclose" h m $+ handleToFd'_noclose h++handleToFd_noclose h@(DuplexHandle _ r w) =+ ioError (System.IO.Error.ioeSetErrorString+ (System.IO.Error.mkIOError IllegalOperation "handleToFd_noclose" (Just h) Nothing)+ "handle is a Duplex")+++handleToFd'_noclose :: Handle -> Handle__ -> IO (Handle__, Fd)++handleToFd'_noclose h h_@Handle__{haType=_, ..} = do+ case cast haDevice of+ Nothing -> ioError (System.IO.Error.ioeSetErrorString+ (System.IO.Error.mkIOError IllegalOperation "handleToFd_noclose" (Just h) Nothing)+ "handle is not a file descriptor")+ Just fd -> do+ -- Removed code (2 lines) which would close the handle.+ return (Handle__{haType=ClosedHandle,..}, Fd (FD.fdFD fd))+-}++++++------------------------------------------------------------------------------------------------------------------------------------------------------++#c+/*+c2hs-0.14.5 chokes on the following includes.+#include <string.h>+#include <stdlib.h>+#include <fcntl.h>+#include <limits.h>+#include <unistd.h>+#include <stdio.h>+*/+char *strerror(int errnum);+int fork(void);+void _exit(int status);+int isatty(int desc);+int close(int fd);+int dup2(int oldfd, int newfd);++++/* Save all file descriptor flags in an array */+int* c_save_fdflags(void);++/* Restore all file descriptor flags from the array, and free it */+void c_restore_fdflags(int* flags);++/* Duplicate a file descriptor, allocating the new one at min or above */+int c_fcntl_dupfd(int fd, int min);++/* Prepare all file descriptors for a subsequent exec */+void c_prepare_fd_flags_for_exec(void);++/* Set a file descriptor to "close on exec" mode. Returns the old flags. */+int c_close_on_exec(int fd);++/* Set the flags of a file descriptor. Returns the old flags. */+int c_set_flags(int fd, int new_flags);+#endc
+ src/HsShellScript/Shell.hs view
@@ -0,0 +1,86 @@+-- #hide+module HsShellScript.Shell where++import Data.List+-- import System++-- |+-- Generate command (for a shell) which corresponds to the specified program+-- name and argument list. The program name and arguments are the usual+-- parameters for calling an external program, like when using+-- @runProcess@ or @run@. The generated shell command+-- would achieve the same effect. The name and the arguments are properly+-- quoted, using 'shell_quote'.+--+-- Note: The quoted strings are correctly recognized in shell scripts. But the shell bash has an annoying history expansion \"feature\", which causes+-- it to choke on exclamation marks, when in interactive mode, even when quoted with double quotes. You can turn it off with @set +o histexpand@.+shell_command :: String -- ^ name or path of the executable+ -> [String] -- ^ command line arguments+ -> String -- ^ shell command+shell_command k par =+ concat (intersperse " " (map shell_quote (k:par)))+++-- |+-- Quote shell metacharacters.+--+-- This function quotes strings, such that they are not misinterpreted by+-- the shell. It tries to be friendly to a human reader - when special+-- characters are present, then the string is quoted with double quotes. If+-- not, it is left unchanged.+--+-- The list of exacly which characters need to be quoted has been taken+-- from the bash source code. Bash in turn, implements POSIX 1003.2. So the+-- result produced should be correct. From the bash info pages:+-- \"... the rules for evaluation and quoting are taken from the POSIX+-- 1003.2 specification for the `standard' Unix shell.\"+--+-- Note: The quoted strings are correctly recognized in shell scripts. But the shell bash has an annoying history expansion \"feature\", which causes+-- it to choke on exclamation marks, when in interactive mode, even when quoted with double quotes. You can turn it off with @set +o histexpand@.+--+-- See 'quote'.+shell_quote :: String -> String+shell_quote "" = "\"\""+shell_quote txt =+ let need_to_quote c = c `elem` "' \t\n\"\\|&;()<>!{}*[?]^$`#"+ in if any need_to_quote txt+ then '"' : quote0' txt+ else txt+ where+ quote0' :: String -> String+ quote0' (z:zs) =+ if (z `elem` "\"$`\\") then ('\\':(z:(quote0' zs)))+ else (z:(quote0' zs))+ quote0' "" = "\""++-- |+-- Quote special characters inside a string for the shell+--+-- This quotes special characters inside a string, such that it is+-- recognized as one string by the shell when enclosed in double quotes.+-- Doesn't add the double quotes.+--+-- Note: The quoted strings are correctly recognized in shell scripts. But the shell bash has an annoying history expansion \"feature\", which causes+-- it to choke on exclamation marks, when in interactive mode, even when quoted with double quotes. You can turn it off with @set +o histexpand@.+--+-- See 'quote', 'shell_quote'.+quote0 :: String -> String+quote0 (z:zs) =+ if (z `elem` "\"$`\\") then ('\\':(z:(quote0 zs)))+ else (z:(quote0 zs))+quote0 "" = ""++-- |+-- Quote a string for the shell+--+-- This encloses a string in double quotes and quotes any special+-- characters inside, such that it will be recognized as one string by a+-- shell. The double quotes are added even when they aren't needed for this+-- purpose.+--+-- Note: The quoted strings are correctly recognized in shell scripts. But the shell bash has an annoying history expansion \"feature\", which causes+-- it to choke on exclamation marks, when in interactive mode, even when quoted with double quotes. You can turn it off with @set +o histexpand@.+--+-- See 'quote0', 'shell_quote'.+quote :: String -> String+quote str = "\"" ++ quote0 str ++ "\""
+ src/cbits/hsshellscript.c view
@@ -0,0 +1,136 @@+/* Common place for the C parts of HsShellScript. */++#include <errno.h>+#include <fcntl.h>+#include <glob.h>+#include <limits.h>+#include <mntent.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <sys/stat.h>+#include <sys/types.h>+#include <unistd.h>++/*#include "HsShellScript/Commands.chs.h"+#include "HsShellScript/ProcErr.chs.h"+#include "HsShellScript/Misc.chs.h"+*/++/* Commands.chs */++char* hsshellscript_get_realpath(char* path)+{+ static char tmp[PATH_MAX+1];+ return realpath(path, tmp);+}++char* hsshellscript_get_readlink(char* path)+{+ static char tmp[PATH_MAX+1];+ int count = readlink(path, tmp, PATH_MAX);+ if (count == -1) return 0;+ tmp[count] = 0;+ return tmp;+}+++/* Misc.chs */++int hsshellscript_open_nonvariadic(const char *pathname, int flags, mode_t mode)+{+ open(pathname, flags, mode);+}++int do_glob(void* buf0, const char* pattern)+{+ glob_t* buf = (glob_t*) buf0;+ int ret;+ buf->gl_pathv = 0;++ printf("pattern = >%s<\n", pattern); /***/++ ret = glob(pattern, GLOB_ERR, 0, buf);++ switch (ret) {+ case 0: return 0;+ case GLOB_ABORTED: return 1;+ case GLOB_NOSPACE: return 2;+ case GLOB_NOMATCH: return 3;+ }+}+++/* ProcErr.chs */+++/* Save all file descriptor flags in an array */+int* c_save_fdflags(void)+{+ int maxfds = sysconf(_SC_OPEN_MAX);+ int* flags = calloc(maxfds, sizeof(int));+ int fd;++ for (fd = 0; fd < maxfds; fd++)+ /* Saves -1 for invalid fds */+ flags[fd] = fcntl(fd, F_GETFL);++ return flags;+}++/* Restore all file descriptor flags from the array, and free it */+void c_restore_fdflags(int* flags)+{+ int maxfds = sysconf(_SC_OPEN_MAX);+ int fd;++ for (fd = 0; fd < maxfds; fd++)+ if (flags[fd] != -1)+ fcntl(fd, F_SETFL, flags[fd]);++ free(flags);+}++/* Duplicate a file descriptor, allocating the new one at min or above */+int c_fcntl_dupfd(int fd, int min)+{+ return fcntl(fd, F_DUPFD, min);+}++/* Prepare all file descriptors for a subsequent exec */+void c_prepare_fd_flags_for_exec(void)+{+ int maxfds = sysconf(_SC_OPEN_MAX);+ int fd, flags;++ /* Set fds 0-2 to blocking mode */+ for (fd = 0; fd < 3; fd++) {+ flags = fcntl(fd, F_GETFL);+ fcntl(fd, F_SETFL, flags & ~O_NONBLOCK);+ }++ /* Set all other fds to close-on-exec */+ for (fd = 3; fd < maxfds; fd++) {+ flags = fcntl(fd, F_GETFL);+ fcntl(fd, F_SETFL, flags | FD_CLOEXEC);+ }+}++/* Set a file descriptor to "close on exec" mode. Returns the old flags. */+int c_close_on_exec(int fd)+{+ int old_flags;+ old_flags = fcntl(fd, F_GETFL);+ fcntl(fd, F_SETFL, old_flags | FD_CLOEXEC);+ return old_flags;+}++/* Set the flags of a file descriptor. Returns the old flags. */+int c_set_flags(int fd, int new_flags)+{+ int old_flags;+ old_flags = fcntl(fd, F_GETFL);+ fcntl(fd, F_SETFL, new_flags);+ return old_flags;+}+