netw (empty) → 0.1.0.0
raw patch · 27 files changed
+2893/−0 lines, 27 filesdep +basedep +netwdep +primitive
Dependencies added: base, netw, primitive, primitive-unaligned, template-haskell, unix
Files
- CHANGELOG.md +7/−0
- LICENSE +674/−0
- cbit/cmsg.c +15/−0
- cbit/recv.c +13/−0
- cbit/recvmsg.c +57/−0
- cbit/send.c +10/−0
- cbit/sendmsg.c +49/−0
- cbit/socket.c +29/−0
- cbit/static_assertion.c +50/−0
- netw.cabal +129/−0
- src/Netw/Ancillary.hs +123/−0
- src/Netw/Inet.hs +157/−0
- src/Netw/Internal.hs +11/−0
- src/Netw/Internal/Ancillary.hsc +23/−0
- src/Netw/Internal/Cmsg.hsc +71/−0
- src/Netw/Internal/Enum.hsc +118/−0
- src/Netw/Internal/Port.hs +77/−0
- src/Netw/Internal/Protocols.hs +25/−0
- src/Netw/Internal/Socket.hs +242/−0
- src/Netw/Internal/Type.hsc +106/−0
- src/Netw/SockAddr.hsc +181/−0
- src/Netw/Socket.hs +421/−0
- test/codegen/Main.hs +10/−0
- test/msgs/Main.hs +74/−0
- test/send-and-recv-msgs/Main.hs +93/−0
- test/server-client/Main.hs +62/−0
- test/unix-scm-rights/Main.hs +66/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for netw++## 0.1.0.0 -- 2024-02-14++* Binding to `socket`, `bind`, `listen`, `getsocketname`, `accept`, `connect`, `send*`, `recv*`, and `shutdown`.+* Data type for UNIX, INET, and INET6 address.+* Transmiting file descriptors over UNIX ancillary data.
+ LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, 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+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If 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 convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU 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+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state 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 program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program 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 General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ cbit/cmsg.c view
@@ -0,0 +1,15 @@+#include <stddef.h>+#include <sys/socket.h>++// It is recommeded to use the macros instead of manipulating msg_control directly+// for portability purposes+struct cmsghdr *cmsg_nxthdr(void *control, size_t controllen, struct cmsghdr *cmsg) {+ struct msghdr msghdr = { .msg_control = control, .msg_controllen = controllen };+ return CMSG_NXTHDR(&msghdr, cmsg);+}++struct cmsghdr *cmsg_firsthdr(void *control, size_t controllen) {+ struct msghdr msghdr = { .msg_control = control, .msg_controllen = controllen };+ return CMSG_FIRSTHDR(&msghdr);+}+
+ cbit/recv.c view
@@ -0,0 +1,13 @@+#include <stdint.h>+#include <stddef.h>+#include <stdio.h>+#include <sys/socket.h>+++ssize_t recv_wrapper(int sockfd, unsigned char *buffer, ptrdiff_t offs, size_t size, int flags) {+ return recv(sockfd, buffer + offs, size, flags);+}++ssize_t recvfrom_wrapper(int fd, char *restrict buf, ptrdiff_t offs, size_t size, int flags, struct sockaddr *restrict addr, socklen_t *addr_len) {+ return recvfrom(fd, buf + offs, size, flags, addr, addr_len);+}
+ cbit/recvmsg.c view
@@ -0,0 +1,57 @@+#include <stdio.h>+#include <stdlib.h>+#include <stddef.h>+#include <sys/socket.h>++#include "Rts.h"++#define SMALL_NELEM 4++ssize_t recvmsg_wrapper0(int sockfd,+ struct sockaddr *name, socklen_t *namelen,+ StgArrBytes **iovecs, ptrdiff_t *offs, size_t *size, size_t iovlen,+ void *control, size_t *controllen,+ int *flags) {+ struct iovec short_iovecs[SMALL_NELEM];+ struct iovec *iov = iovlen > SMALL_NELEM ? malloc(sizeof(*iov) * iovlen) : short_iovecs;++ for (size_t i = 0; i < iovlen; ++i)+ iov[i] = (struct iovec){ .iov_base = (char*)iovecs[i]->payload + offs[i], .iov_len = size[i] };++ struct msghdr msghdr = {+ .msg_name = name, .msg_namelen = *namelen,+ .msg_iov = iov, .msg_iovlen = iovlen,+ .msg_control = control, .msg_controllen = *controllen,+ };++ ssize_t recved = recvmsg(sockfd, &msghdr, *flags);++ if (iovlen > SMALL_NELEM)+ free(iov);+ + // outputing+ *namelen = msghdr.msg_namelen;+ *controllen = msghdr.msg_controllen;+ *flags = msghdr.msg_flags;+ + return recved;+}++ssize_t recvmsg_wrapper1(int sockfd,+ struct sockaddr *name, socklen_t *namelen,+ struct iovec *iov, size_t iovlen,+ void *control, size_t *controllen,+ int *flags) {+ struct msghdr msghdr = {+ .msg_name = name, .msg_namelen = *namelen,+ .msg_iov = iov, .msg_iovlen = iovlen,+ .msg_control = control, .msg_controllen = *controllen,+ };+ ssize_t recved = recvmsg(sockfd, &msghdr, *flags);++ *namelen = msghdr.msg_namelen;+ *controllen = msghdr.msg_controllen;+ *flags = msghdr.msg_flags;++ return recved;+}
+ cbit/send.c view
@@ -0,0 +1,10 @@+#include <stdint.h>+#include <stddef.h>+#include <stdio.h>+#include <sys/socket.h>++ssize_t send_wrapper(int socket, const char *buffer, ptrdiff_t offs, size_t size, int flags) { return send(socket, buffer + offs, size, flags); }+ssize_t sendto_wrapper(int socket, const char *buffer, ptrdiff_t offs, size_t size, int flags,+ const struct sockaddr *name, socklen_t namelen) {+ return sendto(socket, buffer + offs, size, flags, name, namelen);+}
+ cbit/sendmsg.c view
@@ -0,0 +1,49 @@+#include <stddef.h>+#include <stdio.h>+#include <stdlib.h>+#include <sys/socket.h>++#include "Rts.h"++#define SMALL_NELEM 4++ssize_t sendmsg_wrapper0(int fd, + struct sockaddr *name, socklen_t namelen,+ StgArrBytes **iovecs, ptrdiff_t *offs, size_t *len, size_t iovlen,+ void *control, size_t controllen,+ int flags) {+ struct iovec short_iovecs[SMALL_NELEM]; // use if iovlen is small enough+ // else allocate on the heap+ struct iovec *iov = iovlen > SMALL_NELEM ? malloc(sizeof(*iov) * iovlen) : short_iovecs;+ for (size_t i = 0; i < iovlen; ++i)+ iov[i] = (struct iovec){ .iov_base = (char*)iovecs[i]->payload + offs[i], .iov_len = len[i] };++ struct msghdr msghdr = {+ .msg_name = name,+ .msg_namelen = namelen,+ .msg_iov = iov,+ .msg_iovlen = iovlen, + .msg_control = control,+ .msg_controllen = controllen,+ };+ ssize_t ret = sendmsg(fd, &msghdr, flags);+ if (iovlen > SMALL_NELEM)+ free(iov);+ return ret;+}++ssize_t sendmsg_wrapper1(int fd,+ struct sockaddr *name, socklen_t namelen,+ struct iovec *iov, size_t iovlen,+ void *control, size_t controllen,+ int flags) {+ struct msghdr msghdr = {+ .msg_name = name,+ .msg_namelen = namelen,+ .msg_iov = iov,+ .msg_iovlen = iovlen, + .msg_control = control,+ .msg_controllen = controllen,+ };+ return sendmsg(fd, &msghdr, flags);+}
+ cbit/socket.c view
@@ -0,0 +1,29 @@+#include <sys/socket.h>+#if __linux__+#include <linux/version.h>++#if LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,27)+#define USE_LINUX_SOCK_NONBLOCK 1+#endif++#endif++#if !USE_LINUX_SOCK_NONBLOCK+#include <fcntl.h>+#endif++int socket_wrapper(int domain, int type, int protocol) {+#if USE_LINUX_SOCK_NONBLOCK+ return socket(domain, type | SOCK_NONBLOCK, protocol);+#else+ int flags;+ int fd;+ if ((fd = socket(domain, type, protocol)) == -1)+ return -1;+ if ((flags = fcntl(fd, F_GETFL)) == -1)+ return -1;+ if (fcntl(fd, F_SETFL, flags | flags) == -1)+ return -1;+ return fd;+#endif+}
+ cbit/static_assertion.c view
@@ -0,0 +1,50 @@+// This C file contains static_assertions and compile time check (using template haskell)+#include <assert.h>+#include <stdbool.h>+#include <sys/socket.h>++// static_assert(cond, msg);++#define CHECK_CMSG_LEN_BEHAVIOR(s) static_assert(CMSG_LEN(s) == CMSG_LEN(0) + s, "CMSG_LEN behavior unexpected!")+CHECK_CMSG_LEN_BEHAVIOR(0);+CHECK_CMSG_LEN_BEHAVIOR(1);+CHECK_CMSG_LEN_BEHAVIOR(2);+CHECK_CMSG_LEN_BEHAVIOR(3);+CHECK_CMSG_LEN_BEHAVIOR(4);+CHECK_CMSG_LEN_BEHAVIOR(5);+CHECK_CMSG_LEN_BEHAVIOR(6);+CHECK_CMSG_LEN_BEHAVIOR(7);+CHECK_CMSG_LEN_BEHAVIOR(8);+CHECK_CMSG_LEN_BEHAVIOR(9);+CHECK_CMSG_LEN_BEHAVIOR(10);+CHECK_CMSG_LEN_BEHAVIOR(11);+CHECK_CMSG_LEN_BEHAVIOR(12);+CHECK_CMSG_LEN_BEHAVIOR(13);+CHECK_CMSG_LEN_BEHAVIOR(14);+CHECK_CMSG_LEN_BEHAVIOR(15);+CHECK_CMSG_LEN_BEHAVIOR(16);+CHECK_CMSG_LEN_BEHAVIOR(17);+CHECK_CMSG_LEN_BEHAVIOR(18);+CHECK_CMSG_LEN_BEHAVIOR(19);+CHECK_CMSG_LEN_BEHAVIOR(20);+CHECK_CMSG_LEN_BEHAVIOR(21);+CHECK_CMSG_LEN_BEHAVIOR(22);+CHECK_CMSG_LEN_BEHAVIOR(23);+CHECK_CMSG_LEN_BEHAVIOR(24);+CHECK_CMSG_LEN_BEHAVIOR(25);+CHECK_CMSG_LEN_BEHAVIOR(26);+CHECK_CMSG_LEN_BEHAVIOR(27);+CHECK_CMSG_LEN_BEHAVIOR(28);+CHECK_CMSG_LEN_BEHAVIOR(29);+CHECK_CMSG_LEN_BEHAVIOR(30);+CHECK_CMSG_LEN_BEHAVIOR(31);+CHECK_CMSG_LEN_BEHAVIOR(32);+#undef CHECK_CMSG_LEN_BEHAVIOR++#define CHECK_CMSG_DATA_BEHAVIOR(s0, s1) static_assert((char*)CMSG_DATA((struct cmsghdr*)s0) - (char*)s0 == (char*)CMSG_DATA((struct cmsghdr*)s1) - (char*)s1, "CMSG_DATA behavior unexpected!");+CHECK_CMSG_DATA_BEHAVIOR(0x33, 0x72);+CHECK_CMSG_DATA_BEHAVIOR(0x7924, 0x73262);+CHECK_CMSG_DATA_BEHAVIOR(0x9482764, 0x832);+CHECK_CMSG_DATA_BEHAVIOR(0x2460, 0x731);+#undef CHECK_CMSG_LEN_BEHAVIOR+
+ netw.cabal view
@@ -0,0 +1,129 @@+cabal-version: 3.4+name: netw+version: 0.1.0.0+synopsis: Binding to C socket API operating on bytearrays.+license: GPL-3.0-or-later+license-file: LICENSE+author: Vu Hoang Hung+maintainer: Vu Hoang Hung <hoanghung17jan@gmail.com>+stability: experimental+homepage: https://github.com/k355l3r-5yndr0m3/netw+bug-reports: https://github.com/k355l3r-5yndr0m3/netw/issues++description: Provide access to low-level socket api. Work with both bytearrays and pointers.++-- copyright:+category: Network+build-type: Simple++extra-doc-files: CHANGELOG.md+tested-with: GHC == 9.4.8++-- extra-source-files:++flag Debug+ description: Enable debuging flags+ default: False+ manual: True++common warnings+ ghc-options: -Wall++library+ import: warnings++ if flag(Debug)+ ghc-options: -dth-dec-file+ -ddump-splices+ -ddump-to-file+ -Wall++ exposed-modules: Netw.Socket+ Netw.SockAddr+ Netw.Inet+ Netw.Ancillary++ other-modules: Netw.Internal+ Netw.Internal.Port+ Netw.Internal.Protocols+ Netw.Internal.Ancillary+ Netw.Internal.Socket+ Netw.Internal.Enum+ Netw.Internal.Cmsg+ Netw.Internal.Type++ build-depends: base ^>=4.17.2.1,+ primitive >= 0.9.0 && < 0.10,+ template-haskell >= 2.19.0 && < 2.20,+ primitive-unaligned >= 0.1.1 && < 0.2,+ unix >= 2.7.3 && < 2.8,++ hs-source-dirs: src++ c-sources: cbit/sendmsg.c+ cbit/send.c+ cbit/recvmsg.c+ cbit/recv.c+ cbit/cmsg.c+ cbit/socket.c+ cbit/static_assertion.c+ default-language: GHC2021++test-suite server-client-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test/server-client+ main-is: Main.hs+ build-depends:+ base ^>=4.17.2.1,+ primitive,+ unix,+ netw++test-suite msgs-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test/msgs+ main-is: Main.hs+ build-depends:+ base ^>=4.17.2.1,+ primitive,+ unix,+ netw++test-suite unix-scm-rights-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test/unix-scm-rights+ main-is: Main.hs+ build-depends:+ base ^>=4.17.2.1,+ primitive,+ unix,+ netw++test-suite send-and-recv-msgs-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test/send-and-recv-msgs+ main-is: Main.hs+ build-depends:+ base ^>=4.17.2.1,+ primitive,+ unix,+ netw++test-suite codegen-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test/codegen+ main-is: Main.hs+ build-depends:+ base ^>=4.17.2.1,+ netw+
+ src/Netw/Ancillary.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE DataKinds #-}+{-|+Module : Netw.Ancillary+Description : Ancillary data++This module contains ancillary data types. Ancillary data can be send and received via the sendmsg and recvmsg functions.+-}+module Netw.Ancillary where+import Netw.Internal.Ancillary+import qualified Netw.Internal.Cmsg as I++import Control.Monad.Primitive+import Control.Monad+import Control.Exception++import Data.Dynamic+import Data.Foldable+import Data.Function+import Data.Primitive hiding (indexByteArray, writeByteArray, readByteArray)+import Data.Primitive.ByteArray.Unaligned++import System.Posix.Types++import GHC.TypeLits++class (Typeable a, KnownNatPair (Anci a)) => Ancillary a where+ -- | This type family enforces an unique mapping between cmsg_level and cmsg_type pair and the ancillary data type+ type Anci a = (r :: (Nat, Nat)) | r -> a+ -- ^ the order is (cmsg_level, cmsg_type)++ -- | Get the size of the cmsg payload (just cmsg_data[])+ cmsgDataSize :: a -> Int++ -- | Write the payload onto the data section. Take the offset of the data section.+ cmsgPokeData :: PrimMonad m => a -> MutableByteArray (PrimState m) -> Int -> m ()+ -- ^ This function assumes enough space has been allocated++ -- | Read the payload from the data section. Take the offset and size of the payload section.+ cmsgPeekData :: ByteArray -> Int -> Int -> a++cmsgLevel :: forall a. Ancillary a => I.CmsghdrLevel+cmsgLevel = fromIntegral (fstNatVal @(Anci a))++cmsgType :: forall a. Ancillary a => I.CmsghdrType+cmsgType = fromIntegral (sndNatVal @(Anci a))++-- | Find the space a control message element occupies in cmsg buffer given the size of its payload section.+cmsgSpace :: Ancillary a => a -> Int+cmsgSpace = I.cmsgSpace . cmsgDataSize++-- | Read a control message element, assuming type a. Return Nothing if a is not the correct type.+peekAncillary :: forall a. Ancillary a => ByteArray -> Int -> Maybe a+peekAncillary cmsgs hdroffs = I.peekCmsg cmsgs hdroffs reader+ where reader l t b o s+ | l == cmsgLevel @a && t == cmsgType @a =+ Just (cmsgPeekData b o s)+ | otherwise = Nothing+-- | Store a control message element at offset in buffer+pokeAncillary :: forall a m. (Ancillary a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()+pokeAncillary cmsgs hdroffs andat = I.pokeCmsg cmsgs hdroffs l t (cmsgDataSize andat) (cmsgPokeData andat)+ where l = cmsgLevel @a+ t = cmsgType @a+-- ^ Warning: The buffer must be big enough to store the control message element++-- | This data type holds an abitrary ancillary data type.+data AncillaryData = AncillaryData+ { ancillarySpace :: !Int+ , ancillaryData :: !(forall a. Ancillary a => Maybe a)+ , ancillaryWrite :: !(forall m. PrimMonad m => MutableByteArray (PrimState m) -> Int -> m ())+ }++mkAncillaryData :: Ancillary a => a -> AncillaryData+mkAncillaryData a = AncillaryData { ancillarySpace = cmsgSpace a+ , ancillaryData = fromDynamic (toDyn a)+ , ancillaryWrite = \ buffer offset -> pokeAncillary buffer offset a+ }+-- | ancillaryWrite but without the impredicative type+writeAncillary :: PrimMonad m => AncillaryData -> MutableByteArray (PrimState m) -> Int -> m ()+writeAncillary a = ancillaryWrite a++-- | ancillaryData but without the impredicative type+recoverAncillary :: Ancillary a => AncillaryData -> Maybe a+recoverAncillary a = ancillaryData a++{-# INLINE encodeAncillaryData #-}+-- | Encode a list of control message elements+encodeAncillaryData :: [AncillaryData] -> ByteArray+encodeAncillaryData cmsgs = runByteArray $ do+ buffer <- newByteArray size+ zipWithM_ (`writeAncillary` buffer) cmsgs offsets+ return buffer+ where (offsets, size) = (\ a -> (init a, last a)) (scanl (+) 0 (map ancillarySpace cmsgs))+-- ^ Used internally++{-# INLINE decodeAncillaryData #-}+-- | Decode a buffer of control message elements. NOTE: The bytearray must be shrunk to `msg_controllen` bytes before being passed to this function.+decodeAncillaryData :: ByteArray -> [AncillaryData]+decodeAncillaryData cmsgs = fix (\ as offs ->+ if offs < size then+ let space = I.peekCmsg cmsgs offs (\ _ _ _ _ -> I.cmsgSpace)+ andat = AncillaryData { ancillarySpace = space + , ancillaryData = peekAncillary cmsgs offs+ , ancillaryWrite = \ dest destOffs -> copyByteArray dest destOffs cmsgs offs space+ }+ in andat:as (offs + space)+ else []) 0+ where size = sizeofByteArray cmsgs+-- ^ Used internally. Every AncillaryData element holds a reference to the bytearray and keeps it alive.++-- | Transfer file descriptors between sockets+newtype ScmRights = ScmRights [Fd]+instance Ancillary ScmRights where+ type Anci ScmRights = UNIX_CONTROL_MESSAGE_RIGHTS+ cmsgDataSize (ScmRights fds) = sizeOfType @Fd * length fds+ cmsgPokeData (ScmRights fds) buffer initOffs = void (foldlM (\ offs fd -> writeUnalignedByteArray buffer offs fd >> return (offs + sizeOfType @Fd)) initOffs fds)+ cmsgPeekData buffer o s = assert (s `mod` sizeOfType @Fd == 0) $ ScmRights $ fix (\ as offs size ->+ if size > 0 then+ indexUnalignedByteArray buffer offs:as (offs + sizeOfType @Fd) (size - sizeOfType @Fd)+ else+ []) o s
+ src/Netw/Inet.hs view
@@ -0,0 +1,157 @@+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TemplateHaskell #-}+{-|+Module : Netw.Inet+Description : Internet++This module contains internet address types and some utility functions.+-}+module Netw.Inet where+import Netw.Internal.Type+import Netw.Internal.Port++import Data.Bits+import Data.Primitive.ByteArray.Unaligned+import Numeric++import GHC.Exts+import GHC.ByteOrder+import GHC.Word++-- Conversion from host endianness to network endianness (BE)++-- | Convert 16-bit word from host endianness to network endianness (Big endian)+hton16# :: Word16# -> Word16#+-- | Convert 32-bit word from host endianness to network endianness (Big endian)+hton32# :: Word32# -> Word32#+-- | Convert 64-bit word from host endianness to network endianness (Big endian)+hton64# :: Word64# -> Word64#++hton16# = $(case targetByteOrder of LittleEndian -> [| \ w# -> wordToWord16# (byteSwap16# (word16ToWord# w#)) |]; BigEndian -> [| \ w# -> w# |])+hton32# = $(case targetByteOrder of LittleEndian -> [| \ w# -> wordToWord32# (byteSwap32# (word32ToWord# w#)) |]; BigEndian -> [| \ w# -> w# |])+hton64# = $(case targetByteOrder of LittleEndian -> [| byteSwap64# |]; BigEndian -> [| \ w# -> w# |])++-- | Convert 16-bit word from host endianness to network endianness (Big endian)+hton16 :: Word16 -> Word16+hton16 (W16# w) = W16# (hton16# w)++-- | Convert 32-bit word from host endianness to network endianness (Big endian)+hton32 :: Word32 -> Word32+hton32 (W32# w) = W32# (hton32# w)++-- | Convert 64-bit word from host endianness to network endianness (Big endian)+hton64 :: Word64 -> Word64+hton64 (W64# w) = W64# (hton64# w)++-- Conversion from network endianness (BE) to host endianness+-- | Convert 16-bit word from network endianness (Big endian) to host endianness+ntoh16# :: Word16# -> Word16#+-- | Convert 32-bit word from network endianness (Big endian) to host endianness+ntoh32# :: Word32# -> Word32#+-- | Convert 64-bit word from network endianness (Big endian) to host endianness+ntoh64# :: Word64# -> Word64#++ntoh16# = $(case targetByteOrder of LittleEndian -> [| \ w# -> wordToWord16# (byteSwap16# (word16ToWord# w#)) |]; BigEndian -> [| \ w# -> w# |])+ntoh32# = $(case targetByteOrder of LittleEndian -> [| \ w# -> wordToWord32# (byteSwap32# (word32ToWord# w#)) |]; BigEndian -> [| \ w# -> w# |])+ntoh64# = $(case targetByteOrder of LittleEndian -> [| byteSwap64# |]; BigEndian -> [| \ w# -> w# |])++-- | Convert 16-bit word from network endianness (Big endian) to host endianness+ntoh16 :: Word16 -> Word16+ntoh16 (W16# w) = W16# (ntoh16# w)++-- | Convert 32-bit word from network endianness (Big endian) to host endianness+ntoh32 :: Word32 -> Word32+ntoh32 (W32# w) = W32# (ntoh32# w)++-- | Convert 64-bit word from network endianness (Big endian) to host endianness+ntoh64 :: Word64 -> Word64+ntoh64 (W64# w) = W64# (ntoh64# w)++-- | Get the port number in network byteorder +getPortInBE :: Port -> Word16+getPortInBE (Port p) = hton16 p++-- | Get the port number from network byteorder+portFromBE :: Word16 -> Port+portFromBE = Port . ntoh16+++-- | Evaluate to True if port is reserved for super user use.+isReserved :: Port -> Bool+isReserved (Port p) = p < _IPPORT_RESERVED++-- | Evaluate to True if port is reserved for explicit use and is never automatically allocated.+isUserReserved :: Port -> Bool+isUserReserved (Port p) = p >= _IPPORT_USERRESERVED+-- NOTE: Check if >= or > is correct since documents conflict++-- | Port number zero. The OS will assign a random port.+pattern PortRandom :: Port+pattern PortRandom = Port 0++-- | IP version 4 address. Stored in network byteorder.+newtype InAddr = InAddr { inAddrContent :: Word32 } deriving PrimUnaligned++-- | 0.0.0.0+pattern InAddrAny :: InAddr+pattern InAddrAny = InAddr 0++-- | 255.255.255.255+pattern InAddrBroadcast :: InAddr+pattern InAddrBroadcast = InAddr 0xff_ff_ff_ff++-- | 127.0.0.1+pattern InAddrLoopback :: InAddr+pattern InAddrLoopback = InAddr $(case targetByteOrder of LittleEndian -> [p| 0x01_00_00_7f |]; BigEndian -> [p| 0x7f_00_00_01 |])++-- | IP version 6 address. Stored in network byteorder+data In6Addr = In6Addr# (# Word64#, Word64# #)+-- ^ In6Addr# (# high, low #)++-- | Make an IP version 4 address+ip :: Word8 -> Word8 -> Word8 -> Word8 -> InAddr+ip (fromIntegral -> _0) (fromIntegral -> _1) (fromIntegral -> _2) (fromIntegral -> _3) =+ InAddr (shiftL _0 24 .|. shiftL _1 16 .|. shiftL _2 8 .|. shiftL _3 0)++-- | View an IP version 4 address+unIp :: InAddr -> (Word8, Word8, Word8, Word8)+unIp (InAddr addr) = (fromIntegral _0, fromIntegral _1, fromIntegral _2, fromIntegral _3)+ where _0 = shiftR addr 24+ _1 = shiftR addr 16+ _2 = shiftR addr 8+ _3 = shiftR addr 0+instance Show InAddr where+ show (unIp -> (_0, _1, _2, _3)) = show _0 ++ '.' : show _1 ++ '.' : show _2 ++ '.' : show _3++-- | Make an IP version 6 address+ip6 :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> In6Addr+ip6 = ip6'+ where cv :: Int -> Word16 -> Word64+ cv n = (`shiftL` (n * 16)) . fromIntegral . hton16+ ip6' (cv 3 -> _0) (cv 2 -> _1) (cv 1 -> _2) (cv 0 -> _3) (cv 3 -> _4) (cv 2 -> _5) (cv 1 -> _6) (cv 0 -> _7) =+ let !(W64# high#) = _0 .|. _1 .|. _2 .|. _3+ !(W64# low#) = _4 .|. _5 .|. _6 .|. _7+ in In6Addr# (# high#, low# #)++-- | View an IP version 6 address+unIp6 :: In6Addr -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)+unIp6 (In6Addr# (# high#, low# #)) = (vc 3 high#, vc 2 high#, vc 1 high#, vc 0 high#, vc 3 low#, vc 2 low#, vc 1 low#, vc 0 low#)+ where vc :: Int -> Word64# -> Word16+ vc n (W64# -> w) = fromIntegral (shiftR w (8 * n))+instance Show In6Addr where+ showsPrec _ addr = foldr (\ a as -> showHex a . (':' :) . as ) id groups+ where groups = let (a, b, c, d, e, f, g, h) = unIp6 addr in [a, b, c, d, e, f, g, h]+++-- |+-- Port number in internet addresses.+-- The port number is stored in host byteorder and is converted into network+-- byteorder when needed.+newtype Port = Port Word16 deriving (Eq, Ord, Num, Show)++-- Ports+$(declarePorts 'Port)
+ src/Netw/Internal.hs view
@@ -0,0 +1,11 @@+module Netw.Internal (+ module Type+, module Enum+, module Socket+) where++import Netw.Internal.Type as Type+import Netw.Internal.Enum as Enum+import Netw.Internal.Socket as Socket++
+ src/Netw/Internal/Ancillary.hsc view
@@ -0,0 +1,23 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+module Netw.Internal.Ancillary where+import GHC.TypeLits+import Data.Proxy+#include <sys/socket.h>++type UNIX_CONTROL_MESSAGE_RIGHTS = '(#{const SOL_SOCKET}, #{const SCM_RIGHTS})++class KnownNatPair (p :: (Nat, Nat)) where+ {-# MINIMAL fstNatVal, sndNatVal | natPairVal #-}+ natPairVal :: (Integer, Integer)+ natPairVal = (fstNatVal @p, sndNatVal @p)++ fstNatVal :: Integer+ fstNatVal = fst (natPairVal @p)++ sndNatVal :: Integer+ sndNatVal = snd (natPairVal @p)++instance (KnownNat a, KnownNat b) => KnownNatPair '(a, b) where+ fstNatVal = natVal @a Proxy+ sndNatVal = natVal @b Proxy
+ src/Netw/Internal/Cmsg.hsc view
@@ -0,0 +1,71 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE DerivingStrategies #-}+module Netw.Internal.Cmsg where+#include <sys/socket.h>++import Control.Monad.Primitive+import Data.Primitive+import Data.Primitive.ByteArray.Unaligned++import Foreign+import Foreign.C++deriving newtype instance PrimUnaligned CSize++type CmsghdrType = CInt+type CmsghdrLevel = CInt++data {-# CTYPE "sys/socket.h" "struct cmsghdr" #-} Cmsghdr +data {-# CTYPE "unsigned char" #-} Cmsgdata++-- these function are not too nessisary+foreign import capi unsafe "sys/socket.h CMSG_ALIGN"+ _CMSG_ALIGN :: CSize -> CSize+foreign import capi unsafe "sys/socket.h CMSG_SPACE"+ _CMSG_SPACE :: CSize -> CSize+foreign import capi unsafe "sys/socket.h CMSG_LEN"+ _CMSG_LEN :: CSize -> CSize+foreign import capi unsafe "sys/socket.h CMSG_DATA"+ _CMSG_DATA :: Ptr Cmsghdr -> Ptr Cmsgdata++foreign import ccall unsafe "cmsg_nxthdr"+ _CMSG_NXTHDR :: Ptr a -> CSize -> Ptr Cmsghdr -> IO (Ptr Cmsghdr)+foreign import ccall unsafe "cmsg_firsthdr"+ _CMSG_FIRSTHDR :: Ptr a -> CSize -> Ptr Cmsghdr++cmsgSpace :: Int -> Int+cmsgSpace = fromIntegral . _CMSG_SPACE . fromIntegral++{- |+ - `peekCmsg buffer hdroffs reader`+ - `reader` is a function that accept the control message level and type, and the data payload.+ - The payload is given as a buffer, the offset of the payload section (cmsg_data), and the size of the payload (cmsg_len - CMSG_LEN(0)).+ - -}+peekCmsg :: ByteArray -> Int -> (CmsghdrLevel -> CmsghdrType -> ByteArray -> Int -> Int -> a) -> a+peekCmsg buffer hdroffs reader = reader cmsgLevel cmsgType buffer (hdroffs + cmsghdrDataOffset) (fromIntegral $ cmsgSize - cmsghdrSize)+ where cmsgSize = indexUnalignedByteArray @CSize buffer (hdroffs + #{offset struct cmsghdr, cmsg_len})+ cmsgLevel = indexUnalignedByteArray @CmsghdrLevel buffer (hdroffs + #{offset struct cmsghdr, cmsg_level})+ cmsgType = indexUnalignedByteArray @CmsghdrType buffer (hdroffs + #{offset struct cmsghdr, cmsg_type})+ cmsghdrDataOffset = #{const (int)(ptrdiff_t)((char*)CMSG_DATA((struct cmsghdr*)0x01) - (char*)0x01)}+ cmsghdrSize = _CMSG_LEN 0++{- |+ - `pokeCmsg buffer hdroffs cmsgLevel cmsgType cmsgPayloadLen cmsgPayload`+ - Store a control message element info the `buffer` at `hdroffs`.+ - `cmsgPayloadLen` is the length of the data section.+ - `cmsgPayload` is a function that take a buffer, offset into that buffer, and write the data section at that location.+ - -}+pokeCmsg :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> CmsghdrLevel -> CmsghdrType -> Int -> (MutableByteArray (PrimState m) -> Int -> m ()) -> m ()+pokeCmsg buffer hdroffs cmsgLevel cmsgType cmsgPayloadLen cmsgPayload = do+ writeUnalignedByteArray @_ @CSize buffer (hdroffs + #{offset struct cmsghdr, cmsg_len}) (_CMSG_LEN $ fromIntegral cmsgPayloadLen)+ writeUnalignedByteArray @_ @CmsghdrLevel buffer (hdroffs + #{offset struct cmsghdr, cmsg_level}) cmsgLevel+ writeUnalignedByteArray @_ @CmsghdrType buffer (hdroffs + #{offset struct cmsghdr, cmsg_type}) cmsgType+ cmsgPayload buffer (hdroffs + cmsghdrDataOffset)+ where cmsghdrDataOffset = #{const (int)(ptrdiff_t)((char*)CMSG_DATA((struct cmsghdr*)0x01) - (char*)0x01)}++newCmsgBuffer :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))+newCmsgBuffer totalSize = do+ buffer <- newAlignedPinnedByteArray totalSize #{alignment struct cmsghdr}+ fillByteArray buffer 0 totalSize 0+ return buffer
+ src/Netw/Internal/Enum.hsc view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+module Netw.Internal.Enum where+import Netw.Internal.Protocols+{- NOTE: This module is platform-depenent (Linux)+ - -}+#include <sys/socket.h>+#include <netinet/in.h>++import Foreign+import Foreign.C+++newtype ProtocolFamily = ProtocolFamily CInt deriving (Eq)+-- TODO: Add more and maybe use macro to check if value is defined+-- PF_LOCAL and PF_UNIX should be the same on every platform+#if linux_HOST_OS+pattern PF_UNIX = ProtocolFamily #{const PF_UNIX }+pattern PF_LOCAL = ProtocolFamily #{const PF_LOCAL }+pattern PF_INET = ProtocolFamily #{const PF_INET }+pattern PF_AX25 = ProtocolFamily #{const PF_AX25 }+pattern PF_IPX = ProtocolFamily #{const PF_IPX }+pattern PF_APPLETALK = ProtocolFamily #{const PF_APPLETALK }+pattern PF_NETROM = ProtocolFamily #{const PF_NETROM }+pattern PF_BRIDGE = ProtocolFamily #{const PF_BRIDGE }+pattern PF_ATMPVC = ProtocolFamily #{const PF_ATMPVC }+pattern PF_X25 = ProtocolFamily #{const PF_X25 }+pattern PF_INET6 = ProtocolFamily #{const PF_INET6 }+pattern PF_ROSE = ProtocolFamily #{const PF_ROSE }+pattern PF_DECnet = ProtocolFamily #{const PF_DECnet }+pattern PF_NETBEUI = ProtocolFamily #{const PF_NETBEUI }+pattern PF_SECURITY = ProtocolFamily #{const PF_SECURITY }+pattern PF_KEY = ProtocolFamily #{const PF_KEY }+pattern PF_NETLINK = ProtocolFamily #{const PF_NETLINK }+pattern PF_PACKET = ProtocolFamily #{const PF_PACKET }+pattern PF_ECONET = ProtocolFamily #{const PF_ECONET }+pattern PF_ATMSVC = ProtocolFamily #{const PF_ATMSVC }+pattern PF_RDS = ProtocolFamily #{const PF_RDS }+pattern PF_IRDA = ProtocolFamily #{const PF_IRDA }+pattern PF_PPPOX = ProtocolFamily #{const PF_PPPOX }+pattern PF_WANPIPE = ProtocolFamily #{const PF_WANPIPE }+pattern PF_LLC = ProtocolFamily #{const PF_LLC }+pattern PF_IB = ProtocolFamily #{const PF_IB }+pattern PF_MPLS = ProtocolFamily #{const PF_MPLS }+pattern PF_CAN = ProtocolFamily #{const PF_CAN }+pattern PF_TIPC = ProtocolFamily #{const PF_TIPC }+pattern PF_BLUETOOTH = ProtocolFamily #{const PF_BLUETOOTH }+pattern PF_IUCV = ProtocolFamily #{const PF_IUCV }+pattern PF_RXRPC = ProtocolFamily #{const PF_RXRPC }+pattern PF_ISDN = ProtocolFamily #{const PF_ISDN }+pattern PF_PHONET = ProtocolFamily #{const PF_PHONET }+pattern PF_IEEE802154 = ProtocolFamily #{const PF_IEEE802154 }+pattern PF_CAIF = ProtocolFamily #{const PF_CAIF }+pattern PF_ALG = ProtocolFamily #{const PF_ALG }+pattern PF_VSOCK = ProtocolFamily #{const PF_VSOCK }+pattern PF_KCM = ProtocolFamily #{const PF_KCM }+pattern PF_QIPCRTR = ProtocolFamily #{const PF_QIPCRTR }+pattern PF_SMC = ProtocolFamily #{const PF_SMC }+pattern PF_XDP = ProtocolFamily #{const PF_XDP }+#endif++newtype SocketType = SocketType CInt deriving (Eq, Bits)+pattern SOCK_STREAM = SocketType #{const SOCK_STREAM }+pattern SOCK_DGRAM = SocketType #{const SOCK_DGRAM }+pattern SOCK_SEQPACKET = SocketType #{const SOCK_SEQPACKET }++#if linux_HOST_OS+pattern SOCK_RAW = SocketType #{const SOCK_RAW }+pattern SOCK_RDM = SocketType #{const SOCK_RDM }+pattern SOCK_PACKET = SocketType #{const SOCK_PACKET }++-- These are a little different+pattern SOCK_NONBLOCK = SocketType #{const SOCK_NONBLOCK }+pattern SOCK_CLOEXEC = SocketType #{const SOCK_CLOEXEC }+#endif++newtype Protocol = Protocol CInt deriving Eq+pattern DefaultProtocol = Protocol 0+-- Some values have different name from the equivalent in +-- netinet/in.h+$(declareProtocols 'Protocol)++-- These value are not defined in /etc/protocols but is defined+-- in netinet/in.h+#if linux_HOST_OS+pattern IPPROTO_IP = Protocol #{const IPPROTO_IP }+pattern IPPROTO_RAW = Protocol #{const IPPROTO_RAW }+pattern IPPROTO_MPTCP = Protocol #{const IPPROTO_MPTCP}+pattern IPPROTO_MH = Protocol #{const IPPROTO_MH }+#endif++newtype MsgFlags = MsgFlags CInt deriving (Eq, Bits, Storable)+pattern MSG_EOR = MsgFlags #{const MSG_EOR }+pattern MSG_OOB = MsgFlags #{const MSG_OOB }+pattern MSG_NOSIGNAL = MsgFlags #{const MSG_NOSIGNAL }+pattern MSG_PEEK = MsgFlags #{const MSG_PEEK }+pattern MSG_WAITALL = MsgFlags #{const MSG_WAITALL }+pattern MSG_TRUNC = MsgFlags #{const MSG_TRUNC }+pattern MSG_CTRUNC = MsgFlags #{const MSG_CTRUNC }++-- These seem to be specific to linux+-- They don't appear in posix man pages+#if linux_HOST_OS+pattern MSG_CONFIRM = MsgFlags (#const MSG_CONFIRM ) +pattern MSG_DONTROUTE = MsgFlags (#const MSG_DONTROUTE ) +pattern MSG_DONTWAIT = MsgFlags (#const MSG_DONTWAIT ) +pattern MSG_MORE = MsgFlags (#const MSG_MORE ) +pattern MSG_FASTOPEN = MsgFlags (#const MSG_FASTOPEN ) ++pattern MSG_CMSG_CLOEXEC = MsgFlags (#const MSG_CMSG_CLOEXEC )+pattern MSG_ERRQUEUE = MsgFlags (#const MSG_ERRQUEUE )+#endif++newtype ShutHow = ShutHow CInt+pattern SHUT_RD = ShutHow #{const SHUT_RD }+pattern SHUT_WR = ShutHow #{const SHUT_WR }+pattern SHUT_RDWR = ShutHow #{const SHUT_RDWR}
+ src/Netw/Internal/Port.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+module Netw.Internal.Port where+import Netw.Internal.Type++import Data.List+import Data.Char+import qualified Data.List.NonEmpty as N++import Data.Word+import Language.Haskell.TH+++declarePorts :: Name -> DecsQ+declarePorts constructor =+ -- runIO (print . grpOnNameAndPort =<< servents) >> return []+ runIO servents >>= emit . concatMap service . grpOnNameAndPort+ where emit :: [(String, Word16)] -> DecsQ+ emit (sortOn fst -> ports) =+ let grp1 name (a:as)+ | name == fst a = (a:) <$> grp1 name as+ | otherwise = (a:as,[])+ grp1 _ [] = ([], [])+ grp2 (a:as) =+ let (as', p) = grp1 (fst a) as+ in (a N.:| p):grp2 as'+ grp2 [] = []+ list =+ let f (a N.:| as)+ | null as = [a]+ | otherwise = map (\ (name, port) -> (name ++ '_' : show port, port)) (a:as)+ in concatMap f (grp2 ports)+ -- in runIO (print list) >> return []+ in sequence [ patSynD (mkName name)+ (prefixPatSyn [])+ implBidir+ (conP constructor [w16ToLit port])+ | (name, port) <- list ]+ service :: (String, N.NonEmpty (Word16, N.NonEmpty String)) -> [(String, Word16)]+ service (name, pp N.:| pps)+ | null pps = [("IPPORT_" ++ normalize name, fst pp)]+ | otherwise = concat+ [ + [ ("IPPORT_" ++ normalize name ++ '_' : normalize proto, port)+ | proto <- N.toList protos]+ | (port, protos) <- pp:pps]+ w16ToLit = litP . integerL . fromIntegral+ stage1 :: [Servent] -> [(String, N.NonEmpty (Word16, String))]+ stage1 (sortOn sName -> db) =+ let grp1 name (e@(sName -> name'):es)+ | name == name' = ((sPort e, sProto e):) <$> grp1 name es+ | otherwise = (e:es, [])+ grp1 _ [] = ([], [])+ grp2 (e@(sName -> name):es) = + let (es', ports) = grp1 name es+ in (name, (sPort e, sProto e) N.:| ports):grp2 es'+ grp2 [] = []+ in grp2 db+ stage2 :: [(String, N.NonEmpty (Word16, String))] -> [(String, N.NonEmpty (Word16, N.NonEmpty String))]+ stage2 = + map $ + \ (serviceName, N.sortWith fst -> portProt) -> + let grp1 port (pp@(port', proto):pps)+ | port == port' = (proto:) <$> grp1 port pps+ | otherwise = (pp:pps, [])+ grp1 _ [] = ([], [])+ grp2 ((port, proto):pps) =+ let (pps', protos) = grp1 port pps+ in (port, proto N.:| protos):grp2 pps'+ grp2 [] = []+ grp3 ((port, proto) N.:| pps) =+ let (pps', protos) = grp1 port pps+ in (port, proto N.:| protos) N.:| grp2 pps'+ in (serviceName, grp3 portProt)+ grpOnNameAndPort :: [Servent] -> [(String, N.NonEmpty (Word16, N.NonEmpty String))]+ grpOnNameAndPort = stage2 . stage1+ normalize = map $ (\case '-' -> '_'; other -> other) . toUpper
+ src/Netw/Internal/Protocols.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE LambdaCase #-}+module Netw.Internal.Protocols where+import Netw.Internal.Type++import Language.Haskell.TH+import Data.Char (toUpper)++declareProtocols :: Name -> DecsQ+declareProtocols constructor = do+ runIO protoents >>= mapM+ (\ proto ->+ do+ patSynD (mkName $ normalize (pName proto))+ (prefixPatSyn [])+ implBidir+ (conP constructor [litP (integerL $ fromIntegral $ pProto proto)]))+ where normalize =+ let sanitize = \case '-' -> '_'+ '/' -> '_'+ '\\' -> '_'+ ' ' -> '_'+ '+' -> 'p'+ '.' -> '_'+ char -> char+ in ("IPPROTO_"++) . map (sanitize . toUpper)
+ src/Netw/Internal/Socket.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE MagicHash #-}+module Netw.Internal.Socket +( retryOrThrowErrnoIfMinus1+, throwErrnoIfNothing++, socket++, bind#+, bind++, listen++, getsockname#+, getsockname++, accept#+, accept++, connect#+, connect++, send#, send, sendto#+, sendto, sendmsg#, sendmsg++, recv#, recv+, recvfrom#, recvfrom+, recvmsg#, recvmsg++, shutdown+) where+import Netw.Internal.Enum+import Netw.Internal.Type++import Foreign+import Foreign.C++import System.Posix.Types++import GHC.Exts++retryOrThrowErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a+retryOrThrowErrnoIfMinus1 msg action = do+ r <- action+ if r == -1+ then do+ errno <- getErrno+ if errno == eAGAIN || errno == eWOULDBLOCK then+ retryOrThrowErrnoIfMinus1 msg action+ else+ throwErrno msg+ else+ return r+-- Remember to check a (the returned value) to determine if an error occure+-- since something else might have failed before that and errno is no longer EOK+throwErrnoIfNothing :: String -> (a -> Errno -> Maybe b) -> IO a -> IO b+throwErrnoIfNothing msg func act = do+ ret <- act+ err <- getErrno+ let may = func ret err+ case may of+ Nothing -> throwErrno msg+ Just b -> return b++zeroIfMinus1AndEAGAINOrEWOULDBLOCK :: (Num a, Eq a) => a -> Errno -> Maybe a+zeroIfMinus1AndEAGAINOrEWOULDBLOCK (-1) errno+ | errno == eAGAIN || errno == eWOULDBLOCK = Just 0+ | otherwise = Nothing+zeroIfMinus1AndEAGAINOrEWOULDBLOCK a _ = Just a++throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK :: (Num a, Eq a) => String -> IO a -> IO a+throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK msg act = do+ ret <- act+ if ret == -1 + then do+ errno <- getErrno+ if errno == eAGAIN || errno == eWOULDBLOCK+ then + return 0+ else+ throwErrno msg+ else+ return ret++foreign import ccall unsafe "socket_wrapper"+ socket_ :: ProtocolFamily -> SocketType -> Protocol -> IO CInt+socket :: ProtocolFamily -> SocketType -> Protocol -> IO Fd+socket domain stype protocol = Fd <$>+ throwErrnoIfMinus1 "socket failed to create socket"+ (socket_ domain stype protocol)++foreign import ccall unsafe "bind"+ bind_# :: Fd -> ByteArray# -> CSocklen -> IO CInt+bind# :: Fd -> ByteArray# -> CSocklen -> IO ()+bind# sockfd address addressLen =+ throwErrnoIfMinus1_ "bind failed to bind sockfd"+ (bind_# sockfd address addressLen)+foreign import ccall unsafe "bind"+ bind_ :: Fd -> Ptr () -> CSocklen -> IO CInt+bind :: Fd -> Ptr () -> CSocklen -> IO ()+bind sockfd address addressLen =+ throwErrnoIfMinus1_ "bind failed to bind sockfd"+ (bind_ sockfd address addressLen)+++foreign import ccall unsafe "listen"+ listen_ :: Fd -> CInt -> IO CInt+listen :: Fd -> CInt -> IO ()+listen sockfd backlog =+ throwErrnoIfMinus1_ "listen fail"+ (listen_ sockfd backlog)++-- TODO: Add an extra argument to specify retry wait time+foreign import ccall unsafe "accept"+ accept_# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CInt+accept# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO Fd+accept# sockfd address addressLen = Fd <$>+ retryOrThrowErrnoIfMinus1 "accept failed" (accept_# sockfd address addressLen)+foreign import ccall unsafe "accept"+ accept_ :: Fd -> Ptr () -> Ptr CSocklen -> IO CInt +accept :: Fd -> Ptr () -> Ptr CSocklen -> IO Fd+accept sockfd address addressLen = Fd <$>+ retryOrThrowErrnoIfMinus1 "accept failed" (accept_ sockfd address addressLen)++foreign import ccall unsafe "getsockname"+ getsockname_# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CInt+getsockname# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO ()+getsockname# sockfd address addressLen =+ throwErrnoIfMinus1_ "getsockname failed"+ (getsockname_# sockfd address addressLen)++foreign import ccall unsafe "getsockname"+ getsockname_ :: Fd -> Ptr () -> Ptr CSocklen -> IO CInt+getsockname :: Fd -> Ptr () -> Ptr CSocklen -> IO ()+getsockname sockfd address addressLen =+ throwErrnoIfMinus1_ "getsockname failed"+ (getsockname_ sockfd address addressLen)++foreign import ccall unsafe "connect"+ connect_# :: Fd -> ByteArray# -> CSocklen -> IO CInt+connect# :: Fd -> ByteArray# -> CSocklen -> IO ()+connect# sockfd address addressLen =+ throwErrnoIfMinus1_ "connect failed"+ (connect_# sockfd address addressLen)+foreign import ccall unsafe "connect"+ connect_ :: Fd -> Ptr () -> CSocklen -> IO CInt+connect :: Fd -> Ptr () -> CSocklen -> IO ()+connect sockfd address addressLen =+ throwErrnoIfMinus1_ "connect failed"+ (connect_ sockfd address addressLen)++-- Actually sending and recving data+-- The send* function might return zero in case no byte is sent+-- failure is handled+foreign import ccall unsafe "send_wrapper"+ send_# :: Fd -> ByteArray# -> CPtrdiff -> CSize -> MsgFlags -> IO CSsize +send# :: Fd -> ByteArray# -> CPtrdiff -> CSize -> MsgFlags -> IO CSsize+send# fd buf# offs size flags =+ throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "send failed"+ (send_# fd buf# offs size flags)++foreign import ccall unsafe "send"+ send_ :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> IO CSsize +send :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> IO CSsize+send fd buf size flags = + throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "send failed"+ (send_ fd buf size flags)++foreign import ccall unsafe "sendto_wrapper"+ sendto_# :: Fd -> ByteArray# -> CPtrdiff -> CSize -> MsgFlags -> ByteArray# -> CSocklen -> IO CSsize+sendto# :: Fd -> ByteArray# -> CPtrdiff -> CSize -> MsgFlags -> ByteArray# -> CSocklen -> IO CSsize+sendto# fd buf# offs size flags addr# addrlen =+ throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "sendto failed"+ (sendto_# fd buf# offs size flags addr# addrlen)+foreign import ccall unsafe "sendto"+ sendto_ :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> ByteArray# -> CSocklen -> IO CSsize+sendto :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> ByteArray# -> CSocklen -> IO CSsize+sendto fd buf size flags addr# addrlen = + throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "sendto failed"+ (sendto_ fd buf size flags addr# addrlen)++foreign import ccall unsafe "sendmsg_wrapper0" -- iovecs offs size nvec+ sendmsg_# :: Fd -> ByteArray# -> CSocklen -> Array# ByteArray# -> ByteArray# -> ByteArray# -> CSize -> Ptr () -> CSize -> MsgFlags -> IO CSsize+sendmsg# :: Fd -> ByteArray# -> CSocklen -> Array# ByteArray# -> ByteArray# -> ByteArray# -> CSize -> Ptr () -> CSize -> MsgFlags -> IO CSsize+sendmsg# fd addr# addrlen iovecs offs size nvec cmsg cmsglen flags =+ throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "sendmsg failed"+ (sendmsg_# fd addr# addrlen iovecs offs size nvec cmsg cmsglen flags)++foreign import ccall unsafe "sendmsg_wrapper1"+ sendmsg_ :: Fd -> ByteArray# -> CSocklen -> Ptr Iovec -> CSize -> Ptr () -> CSize -> MsgFlags -> IO CSsize+sendmsg :: Fd -> ByteArray# -> CSocklen -> Ptr Iovec -> CSize -> Ptr () -> CSize -> MsgFlags -> IO CSsize+sendmsg fd addr# addrlen iovecs ioveclen cmsg cmsglen flags =+ throwErrnoIfMinus1UnlessEAGAINorEWOULDBLOCK "sendmsg failed"+ (sendmsg_ fd addr# addrlen iovecs ioveclen cmsg cmsglen flags)++foreign import ccall unsafe "recv_wrapper"+ recv_# :: Fd -> MutableByteArray# RealWorld -> CPtrdiff -> CSize -> MsgFlags -> IO CSsize+recv# :: Fd -> MutableByteArray# RealWorld -> CPtrdiff -> CSize -> MsgFlags -> IO CSsize+recv# fd buf# offs size flags =+ retryOrThrowErrnoIfMinus1 "recv failed"+ (recv_# fd buf# offs size flags)++foreign import ccall unsafe "recv"+ recv_ :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> IO CSsize+recv :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> IO CSsize+recv fd buf size flags =+ retryOrThrowErrnoIfMinus1 "recv failed"+ (recv_ fd buf size flags)++foreign import ccall unsafe "recvfrom_wrapper"+ recvfrom_# :: Fd -> MutableByteArray# RealWorld -> CPtrdiff -> CSize -> MsgFlags -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CSsize+recvfrom# :: Fd -> MutableByteArray# RealWorld -> CPtrdiff -> CSize -> MsgFlags -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CSsize+recvfrom# fd buf# offs size flags addr# addrlen =+ retryOrThrowErrnoIfMinus1 "recvfrom failed"+ (recvfrom_# fd buf# offs size flags addr# addrlen)++foreign import ccall unsafe "recvfrom"+ recvfrom_ :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CSsize+recvfrom :: Fd -> Ptr Word8 -> CSize -> MsgFlags -> MutableByteArray# RealWorld -> Ptr CSocklen -> IO CSsize+recvfrom fd buf size flags addr# addrlen =+ retryOrThrowErrnoIfMinus1 "recvfrom failed"+ (recvfrom_ fd buf size flags addr# addrlen)++foreign import ccall unsafe "recvmsg_wrapper0"+ recvmsg_# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> Array# (MutableByteArray# RealWorld) -> ByteArray# -> ByteArray# -> CSize -> Ptr a -> Ptr CSize -> Ptr MsgFlags -> IO CSsize+recvmsg# :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> Array# (MutableByteArray# RealWorld) -> ByteArray# -> ByteArray# -> CSize -> Ptr a -> Ptr CSize -> Ptr MsgFlags -> IO CSsize+recvmsg# fd addr# addrlen iovecs# offs size ioveclen cmsg cmsglen flags =+ retryOrThrowErrnoIfMinus1 "recvmsg failed"+ (recvmsg_# fd addr# addrlen iovecs# offs size ioveclen cmsg cmsglen flags)++foreign import ccall unsafe "recvmsg_wrapper1"+ recvmsg_ :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> Ptr Iovec -> CSize -> Ptr a -> Ptr CSize -> Ptr MsgFlags -> IO CSsize+recvmsg :: Fd -> MutableByteArray# RealWorld -> Ptr CSocklen -> Ptr Iovec -> CSize -> Ptr a -> Ptr CSize -> Ptr MsgFlags -> IO CSsize+recvmsg fd addr# addrlen iovecs ioveclen cmsg cmsglen flags =+ retryOrThrowErrnoIfMinus1 "recvmsg failed"+ (recvmsg_ fd addr# addrlen iovecs ioveclen cmsg cmsglen flags)++foreign import ccall unsafe "shutdown"+ shutdown_ :: Fd -> ShutHow -> IO CInt+shutdown :: Fd -> ShutHow -> IO ()+shutdown fd = throwErrnoIfMinus1_ "shutdown failed" . shutdown_ fd
+ src/Netw/Internal/Type.hsc view
@@ -0,0 +1,106 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Netw.Internal.Type +( Iovec(..)+, sizeofSockaddrStorage+, Protoent(..), protoents+, Servent(..), servents+, _IPPORT_RESERVED, _IPPORT_USERRESERVED+) where+#include <netdb.h>+#include <sys/socket.h>++import Foreign+import Foreign.C++import Data.Primitive+import Data.Function++import Data.Word+import GHC.ByteOrder++data Iovec = Iovec { iovBase :: !(Ptr ()), iovLen :: !CSize }+instance Storable Iovec where+ sizeOf _ = #{size struct iovec}+ alignment _ = #{alignment struct iovec}++ peek ptr = Iovec <$> #{peek struct iovec, iov_base} ptr <*> #{peek struct iovec, iov_len} ptr+ poke ptr iovec = #{poke struct iovec, iov_base} ptr (iovBase iovec)+ >> #{poke struct iovec, iov_len} ptr (iovLen iovec)++sizeofSockaddrStorage :: Int+sizeofSockaddrStorage = #{size struct sockaddr_storage}++data Protoent = Protoent+ { pName :: String+ , pAliases :: [String]+ , pProto :: CInt+ }++peekProtoent :: Ptr Protoent -> IO Protoent+peekProtoent ptr = do+ name <- peekCString =<< #{peek struct protoent, p_name} ptr+ proto <- #{peek struct protoent, p_proto} ptr+ aliases <- mapM peekCString =<< peekArray0 nullPtr =<< #{peek struct protoent, p_aliases} ptr+ return (Protoent name aliases proto)++foreign import ccall unsafe "getprotoent"+ getprotoent :: IO (Ptr Protoent)+foreign import ccall unsafe "endprotoent"+ endprotoent :: IO ()++protoents :: IO [Protoent]+protoents = do+ endprotoent+ fix (\ loop -> do+ proto' <- getprotoent+ if proto' == nullPtr+ then do+ endprotoent+ return []+ else do+ proto <- peekProtoent proto'+ (proto:) <$> loop+ )++data Servent = Servent+ { sName :: String+ , sAliases :: [String]+ , sPort :: Word16 -- NOTE: This is in host byte order+ , sProto :: String+ }++peekServent :: Ptr Servent -> IO Servent+peekServent ptr = do+ name <- peekCString =<< #{peek struct servent, s_name} ptr+ aliases <- mapM peekCString =<< peekArray0 nullPtr =<< #{peek struct servent, s_aliases} ptr+ port :: CInt+ <- #{peek struct servent, s_port} ptr+ proto <- peekCString =<< #{peek struct servent, s_proto} ptr+ return (Servent name aliases (ntoh $ fromIntegral port) proto)+ where ntoh :: Word16 -> Word16+ ntoh = case targetByteOrder of LittleEndian -> byteSwap16; BigEndian -> id++foreign import ccall unsafe "getservent"+ getservent :: IO (Ptr Servent)+foreign import ccall unsafe "endservent"+ endservent :: IO ()++servents :: IO [Servent]+servents = do+ endservent+ fix (\ loop -> do+ serv' <- getservent+ if serv' == nullPtr+ then do+ endservent+ return []+ else do+ serv <- peekServent serv'+ (serv:) <$> loop+ )++_IPPORT_RESERVED :: Word16+_IPPORT_RESERVED = #{const IPPORT_RESERVED}++_IPPORT_USERRESERVED :: Word16+_IPPORT_USERRESERVED = #{const IPPORT_USERRESERVED}
+ src/Netw/SockAddr.hsc view
@@ -0,0 +1,181 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-|+Module : Netw.SockAddr+Description : Various socket address types+-}+module Netw.SockAddr +( SockAddr (..), Addr(..)+, mkAddr+, newSockAddrStorage+, SockAddrNull (..), SockAddrUn (..)+, SockAddrIn (..), SockAddrIn6 (..)+) where+#include <sys/socket.h>+#include <sys/un.h>+#include <netinet/in.h>+import Netw.Internal.Type (sizeofSockaddrStorage)+import Netw.Inet++import Control.Exception (assert)+import Control.Monad.Primitive++import Data.Char+import Data.Functor+import Data.Foldable++import Data.Primitive+import Data.Primitive.ByteArray.Unaligned++import GHC.Word++type CSaFamily = #{type sa_family_t} -- Don't export this, it is only used here++-- | A type that represent some socket address+newtype Addr = Addr { unAddr :: forall a. SockAddr a => Maybe a }+mkAddr :: ByteArray -> Addr+mkAddr ba = Addr (byteArrayToSockAddr ba)++class SockAddr a where+ {-# MINIMAL sockAddrToByteArray, byteArrayToSockAddr #-}+ -- | Convert a socket address to its C equivalent+ sockAddrToByteArray :: a -> ByteArray+ -- | Convert a socket address from its C equivalent+ byteArrayToSockAddr :: ByteArray -> Maybe a++ -- | Check if this bytearray contain a socket address of this type+ isByteArrayThisAddr :: ByteArray -> Bool+ isByteArrayThisAddr ba+ | Just _ <- byteArrayToSockAddr @a ba = True+ | otherwise = False++ -- | Find the required number of bytes to store the C struct+ sockAddrSize :: a -> Int+ sockAddrSize = sizeofByteArray . sockAddrToByteArray++-- TODO: Move this to an internal module+newSockAddrStorage :: PrimMonad m => m (MutableByteArray (PrimState m))+newSockAddrStorage = newByteArray sizeofSockaddrStorage++-- | A null socket address. Equivalent to not specifying a socket address.+data SockAddrNull = SockAddrNull+instance SockAddr SockAddrNull where+ isByteArrayThisAddr = (0 ==) . sizeofByteArray+ sockAddrSize = const 0++ sockAddrToByteArray _ = emptyByteArray+ byteArrayToSockAddr a+ | sizeofByteArray a == 0 = Just SockAddrNull+ | otherwise = Nothing++-- | UNIX Socket address+newtype SockAddrUn = SockAddrUn FilePath deriving (Eq, Show)+-- NOTE: There is an extension on linux that add abstract socket address for+-- unix sockets. It is quite nonportable according to the man page+-- might implement it+instance SockAddr SockAddrUn where+ sockAddrSize (SockAddrUn sunPath) = #{offset struct sockaddr_un, sun_path} + length sunPath+ isByteArrayThisAddr = isSaFamily #{const AF_LOCAL}++ sockAddrToByteArray addr@(SockAddrUn sunPath) = runByteArray $ do+ sockaddr <- newByteArray len+ writeSaFamily sockaddr #{const AF_LOCAL}+ nullAt <- foldlM (\ idx char -> assert (isAscii char) (writeByteArray @Word8 sockaddr idx (toEnum (ord char))) >> return (succ idx)) #{offset struct sockaddr_un, sun_path} sunPath + writeByteArray @Word8 sockaddr nullAt 0+ return sockaddr+ where len = sockAddrSize addr+ byteArrayToSockAddr ba -- TODO: Check if the address is a linux abstract address (which start with a null byte)+ | isByteArrayThisAddr @SockAddrUn ba =+ let lstIdx = sizeofByteArray ba - 1 {- NOTE on linux a NULL byte is appened to the end if the NULL byte is present -}+ addrStr = [let char = chr (fromEnum ch) in assert (isAscii char) char | ch <- [#{offset struct sockaddr_un, sun_path}..lstIdx] <&> indexByteArray @Word8 ba, ch /= 0]+ in Just (SockAddrUn addrStr)+ | otherwise = Nothing++-- | IPv4 socket address+data SockAddrIn = SockAddrIn+ { sinPort :: !Port+ , sinAddr :: !InAddr+ }+instance SockAddr SockAddrIn where+ sockAddrSize _ = #{size struct sockaddr_in}+ isByteArrayThisAddr = isSaFamily #{const AF_INET}++ sockAddrToByteArray a@(SockAddrIn port addr) = runByteArray $ do+ sockaddr <- newByteArray len+ writeSaFamily sockaddr #{const AF_INET}+ writeAddr sockaddr portOffs (getPortInBE port)+ writeAddr sockaddr addrOffs addr+ return sockaddr+ where len = sockAddrSize a+ portOffs = #{offset struct sockaddr_in, sin_port}+ addrOffs = #{offset struct sockaddr_in, sin_addr} + #{offset struct in_addr, s_addr}+ byteArrayToSockAddr ba+ | isByteArrayThisAddr @SockAddrIn ba && sizeofByteArray ba >= #{size struct sockaddr_in} = -- #{offset struct sockaddr_in, sin_addr} + #{size struct in_addr} =+ let portOffs = #{offset struct sockaddr_in, sin_port}+ addrOffs = #{offset struct sockaddr_in, sin_addr} + #{offset struct in_addr, s_addr}+ addr = SockAddrIn { sinPort = portFromBE $ indexAddr ba portOffs+ , sinAddr = indexAddr ba addrOffs+ }+ in Just addr+ | otherwise = Nothing++-- | IPv6 socket address+data SockAddrIn6 = SockAddrIn6+ { sin6Port :: !Port+ , sin6Flowinfo :: !Word32+ , sin6Addr :: !In6Addr+ , sin6ScopeId :: !Word32+ }+instance SockAddr SockAddrIn6 where+ sockAddrSize _ = #{size struct sockaddr_in6}+ isByteArrayThisAddr = isSaFamily #{const AF_INET6}++ sockAddrToByteArray a@(SockAddrIn6 port flow (In6Addr## (## high##, low## ##)) scope) = runByteArray $ do+ sockaddr <- newByteArray len+ writeSaFamily sockaddr #{const AF_INET6}+ writeAddr sockaddr portOffs (getPortInBE port)+ writeAddr sockaddr flowOffs (hton32 flow)+ writeAddr sockaddr addrHighOffs (W64## high##)+ writeAddr sockaddr addrLowOffs (W64## low##)+ writeAddr sockaddr scopeOffs (hton32 scope)+ return sockaddr+ where len = sockAddrSize a+ portOffs = #{offset struct sockaddr_in6, sin6_port}+ flowOffs = #{offset struct sockaddr_in6, sin6_flowinfo}+ scopeOffs = #{offset struct sockaddr_in6, sin6_scope_id}+ addrOffs = #{offset struct sockaddr_in6, sin6_addr} + #{offset struct in6_addr, s6_addr}+ addrHighOffs = addrOffs+ addrLowOffs = addrOffs + sizeOfType @Word64++ byteArrayToSockAddr ba+ | isByteArrayThisAddr @SockAddrIn6 ba && sizeofByteArray ba >= #{size struct sockaddr_in6} =+ let portOffs = #{offset struct sockaddr_in6, sin6_port}+ flowOffs = #{offset struct sockaddr_in6, sin6_flowinfo}+ scopeOffs = #{offset struct sockaddr_in6, sin6_scope_id}+ addrOffs = #{offset struct sockaddr_in6, sin6_addr} + #{offset struct in6_addr, s6_addr}+ addrHighOffs = addrOffs+ addrLowOffs = addrOffs + sizeOfType @Word64+ !(W64## high##) = indexAddr ba addrHighOffs+ !(W64## low##) = indexAddr ba addrLowOffs+ addr = SockAddrIn6 { sin6Port = portFromBE $ indexAddr ba portOffs+ , sin6Flowinfo = ntoh32 (indexAddr ba flowOffs)+ , sin6Addr = In6Addr## (## high##, low## ##)+ , sin6ScopeId = ntoh32 (indexAddr ba scopeOffs)+ }+ in Just addr+ | otherwise = Nothing++-- this is used internally+writeSaFamily :: PrimMonad m => MutableByteArray (PrimState m) -> CSaFamily -> m ()+writeSaFamily = (`writeByteArray` 0)++writeAddr :: (PrimUnaligned a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()+writeAddr = writeUnalignedByteArray++indexAddr :: PrimUnaligned a => ByteArray -> Int -> a+indexAddr = indexUnalignedByteArray++isSaFamily :: CSaFamily -> ByteArray -> Bool+isSaFamily fam ba = sizeofByteArray ba >= #{size sa_family_t} && fam == indexByteArray @CSaFamily ba 0
+ src/Netw/Socket.hs view
@@ -0,0 +1,421 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-|+Module : Netw.Socket+Description : Core functions++This module contains all the functions required to create and use sockets.+-}+module Netw.Socket +( Socket+, socket, closeSocket+, bind, listen, getsockname+, accept, accept_+, connect++, sendall, send, send'+, sendallto, sendto, sendto'+, sendmsg, sendmsg'++, recvsome, recv, recv'+, recvfrom, recvfrom', recvsomefrom+, recvmsg, recvmsg_++, shutdown+, module Netw.Internal.Enum+) where+import qualified Netw.Internal.Socket as I+import Netw.Internal.Enum+import Netw.Internal.Type+import Netw.Internal.Cmsg (newCmsgBuffer)++import Netw.SockAddr+import Netw.Ancillary++import Control.Monad+import Control.Monad.ST+import Control.Monad.Primitive++import Data.Function+import Data.Functor+import Data.Primitive+import Data.Word++import Foreign+import Foreign.C.Types++import System.Posix.Types+import System.Posix.IO++import GHC.Exts++-- |+-- A file descriptor that is a socket.+-- All socket used by this library is in nonblocking mode (O_NONBLOCK)+newtype Socket = MkSocket { unSocket :: Fd } ++-- | Create a new socket (see `man 3 socket`)+socket :: ProtocolFamily -> SocketType -> Protocol -> IO Socket+socket domain -- ^ The protocol family of the address (an PF_* value)+ stype -- ^ The socket types (SOCK_STREAM, SOCK_RAW, etc)+ protocol -- ^ The protocol. Usually passing DefaultProtocol work.+ = MkSocket <$> I.socket domain stype protocol++-- | Close a socket (see `man 3 close`)+closeSocket :: Socket -> IO ()+closeSocket = closeFd . unSocket++-- | Bind a socket to an address (see `man 3 bind`)+bind :: SockAddr a => Socket -> a -> IO ()+bind (unSocket -> sock) sockaddr@(sockAddrToByteArray -> addr@(ByteArray addr#))+ | sockAddrSize sockaddr > 0 = I.bind# sock addr# (fromIntegral $ sizeofByteArray addr)+ | otherwise = I.bind sock nullPtr 0++-- | Mark a socket as accepting connection (see `man 3 listen`)+listen :: Socket -> Int -> IO ()+listen (unSocket -> sock) (fromIntegral -> backlog) =+ I.listen sock backlog++-- | Retrieve the name of the socket (see `man 3 getsockname`)+getsockname :: Socket -> IO Addr+getsockname (unSocket -> sock) = + with 0 $ \ sockaddrLen -> do+ I.getsockname sock nullPtr sockaddrLen+ sockaddr@(MutableByteArray sockaddr#) <- newByteArray . fromIntegral =<< peek sockaddrLen+ I.getsockname# sock sockaddr# sockaddrLen+ mkAddr <$> unsafeFreezeByteArray sockaddr++-- | Extract the first connection on the pending connection queue (see `man 3 accept`). This function blocks the calling thread until a connection is made.+accept :: Socket -> IO (Socket, Addr)+accept (unSocket -> sock) = + with sockaddrLenGuess $ \ sockaddrLen -> do -- TODO: Check the doc if the address returned from accept is the same as getsockname+ sockaddr@(MutableByteArray sockaddr#) <- newByteArray (fromIntegral sockaddrLenGuess)+ peer <- MkSocket <$> I.accept# sock sockaddr# sockaddrLen+ len <- peek sockaddrLen+ (peer, ) <$>+ if len > sockaddrLenGuess+ then do+ addr@(MutableByteArray addr#) <- newByteArray (fromIntegral len)+ I.getsockname# (unSocket peer) addr# sockaddrLen+ mkAddr <$> unsafeFreezeByteArray addr+ else do+ mkAddr <$> (unsafeFreezeByteArray =<< resizeMutableByteArray sockaddr (fromIntegral len))+ where sockaddrLenGuess = 128++-- | A version of `accept` which does not return the peer address+accept_ :: Socket -> IO Socket+accept_ (unSocket -> sock) = MkSocket <$> I.accept sock nullPtr nullPtr++-- | Try to connect to an address (see `man 3 connect`)+connect :: SockAddr a => Socket -> a -> IO ()+connect (unSocket -> sock) sockaddr@(sockAddrToByteArray -> addr@(ByteArray addr#))+ | sockAddrSize sockaddr > 0 = I.connect# sock addr# (fromIntegral $ sizeofByteArray addr)+ | otherwise = I.connect sock nullPtr 0++-- You can shave off maybe one clock cycle if this is change to use send and not send_wrapper+++-- |+-- `send socket buffer offset size flags`+-- Send a range of bytes in buffer located at offset and is size bytes long.+-- Return the number of bytes accually sent which may be less than+-- the number of bytes specified.+-- Block the current thread until some bytes are sent.+-- (see `man 3 send`)+send :: Socket -> ByteArray -> Int -> Int -> MsgFlags -> IO Int+send (unSocket -> fd) -- ^ A connected socket+ (ByteArray buf#) -- ^ Message buffer+ offs -- ^ Offset in bytes into the message buffer to start sending+ size -- ^ Number of bytes to send+ flags -- ^ Specify the type of message transmisstion (MSG_EOR, MSG_OOB, MSG_NOSIGNAL or more depend on platform)+ = fromIntegral <$> I.send# fd buf# (fromIntegral offs) (fromIntegral size) flags++-- | A version of `send` that accept a pointer instead of a bytearray.+send' :: Socket -> Ptr Word8 -> Int -> MsgFlags -> IO Int+send' (unSocket -> sockfd) -- ^ A connected socket+ buf -- ^ Pointer to the message buffer+ len -- ^ Number of bytes to send+ flags -- ^ Specify the type of message transmisstion (MSG_EOR, MSG_OOB, MSG_NOSIGNAL or more depend on platform)+ = fromIntegral <$> I.send sockfd buf (fromIntegral len) flags++-- | +-- Send the whole content of a bytearray through a socket.+-- Block until the entire bytearray has been sent.+sendall :: Socket -> ByteArray -> MsgFlags -> IO ()+sendall sock buf flags = fix (\ resend offs size ->+ when (size > 0) $ do+ sent <- send sock buf offs size flags+ resend (offs + sent) (size - sent)) 0 (sizeofByteArray buf)++-- |+-- A version of `send` that accept the destination address (see `man 3 sendto`)+-- Return the number of bytes accually sent which may be less than+-- the number of bytes specified.+-- Block the thread until some bytes are sent.+sendto :: SockAddr a => Socket -> ByteArray -> Int -> Int -> MsgFlags -> a -> IO Int+sendto (unSocket -> fd) -- ^ A connection-mode or connectionless-mode socket+ (ByteArray buf#) -- ^ The buffer containing the message+ offs -- ^ Offset in bytes into the message buffer specifying where to start sending+ size -- ^ Number of bytes to send+ flags -- ^ Transmission flags+ (sockAddrToByteArray -> addr@(ByteArray addr#)) -- ^ Destination address (Should be SockAddrNull if using a connected socket)+ = fromIntegral <$> I.sendto# fd buf# (fromIntegral offs) (fromIntegral size) flags addr# (fromIntegral $ sizeofByteArray addr)++-- | A version of `sendto` that accept a pointer instead of a bytearray+sendto' :: SockAddr a => Socket -> Ptr Word8 -> Int -> MsgFlags -> a -> IO Int+sendto' (unSocket -> sockfd) -- ^ A connection-mode or connectionless-mode socket+ buf -- ^ Pointer to message buffer+ (fromIntegral -> len) -- ^ Number of bytes to send+ flags -- ^ Transmission flags+ (sockAddrToByteArray -> addr@(ByteArray addr#)) -- ^ Destination address+ = fromIntegral <$> I.sendto sockfd buf len flags addr# (fromIntegral $ sizeofByteArray addr)++-- | Send the whole content of a bytearray+sendallto :: SockAddr a => Socket -> ByteArray -> MsgFlags -> a -> IO ()+sendallto sock buf flag addr = + fix (\ resend offs size -> + when (size > 0) $ do+ sent <- sendto sock buf offs size flag addr + resend (offs + sent) (size - sent)) 0 (sizeofByteArray buf)++-- lifting (TODO: Find a better more anonymous method)+data State s = State (State# s)+data ArrayByteArray = ArrayByteArray (Array# ByteArray#)+data ArrayMutableByteArray = ArrayMutableByteArray (Array# (MutableByteArray# RealWorld))++{-|+`sendmsg socket address iovecs cmsgs flags`+The iovecs argument is a list of 3-tuples of the data buffer, the offset in bytes,+and the number of bytes to send. Use SockAddrNull if no address is to be specified.+This function blocks the calling thread and return the number of bytes sent, which+may be less than the intended message size.++(See `man 3 sendmsg`)+-}+sendmsg :: SockAddr a => Socket -> a -> [(ByteArray, Int, Int)] -> [AncillaryData] -> MsgFlags -> IO Int+sendmsg (unSocket -> sockfd) -- ^ A connection-mode or connectionless-mode socket+ addr -- ^ Destination address+ (unzip3 -> (iovecs, offs, size)) -- ^ A list of message which will be send from left to right. Semantics: (Buffer, Offset(bytes), Size(bytes))+ (encodeAncillaryData -> control) -- ^ Ancillary data+ flags -- ^ Transmisstion flags+ = withByteArrayContents control $ \ control' ->+ fromIntegral <$> I.sendmsg# sockfd + addr# (fromIntegral addrLen)+ iovecs# offs# size# (fromIntegral iovlen)+ (castPtr control') (fromIntegral $ sizeofByteArray control)+ flags+ where !(PrimArray offs#) = fromList (fromIntegral <$> offs) :: PrimArray CPtrdiff+ !(PrimArray size#) = fromList (fromIntegral <$> size) :: PrimArray CSize+ !(ArrayByteArray iovecs#) = runST $ primitive $ \ state0# ->+ let !(# state1#, mutarr# #) + = newArray# iovlen# emptyByteArray# state0# in+ let !(State state4#, _)+ = foldl (\ (State state2#, idx@(I# idx#)) (ByteArray iov#) ->+ let state3# = writeArray# mutarr# idx# iov# state2#+ in (State state3#, idx + 1) ) (State state1#, 0 :: Int) iovecs in+ let !(# state5#, arr# #)+ = unsafeFreezeArray# mutarr# state4# in+ (# state5#, ArrayByteArray arr# #)+ !iovlen@(I# iovlen#) = length iovecs+ !(ByteArray emptyByteArray#) = emptyByteArray+ !(ByteArray addr#) = sockAddrToByteArray addr+ addrLen = sockAddrSize addr++-- | A version of `sendmsg` that uses pointers instead of bytearrays+sendmsg' :: SockAddr a => Socket -> a -> [(Ptr Word8, Int)] -> [AncillaryData] -> MsgFlags -> IO Int+sendmsg' (unSocket -> sockfd) addr iovecs (encodeAncillaryData -> control) flags =+ withByteArrayContents control $ \ control' ->+ withArray iov $ \ iov' ->+ fromIntegral <$> I.sendmsg sockfd+ addr# (fromIntegral addrLen)+ iov' (fromIntegral iovlen)+ (castPtr control') (fromIntegral $ sizeofByteArray control)+ flags+ where addrLen = sockAddrSize addr+ !(ByteArray addr#) = sockAddrToByteArray addr+ iov = iovecs <&> \ (ptr, len) -> Iovec (castPtr ptr) (fromIntegral len)+ iovlen = length iovecs++{-|+`recvsome socket n flags`+Receive a maximum of `n` bytes from `socket`.+Return the message as a bytearray. If the bytearray is empty (size == 0) then there is no more data to be read and the socket+should be closed.+-}+recvsome :: Socket -> Int -> MsgFlags -> IO ByteArray+recvsome sock maxBytesRecv flags = do+ mutarr <- newByteArray maxBytesRecv+ bytesRecv <- recv sock mutarr 0 maxBytesRecv flags+ shrinkMutableByteArray mutarr (fromIntegral bytesRecv)+ unsafeFreezeByteArray mutarr++{-|+`recv socket buffer offset size flags`+Receive a maximum of `size` bytes from `socket`, storing those bytes in `buffer` at `offset`+Return the number of bytes received. (See `man 3 recv`)+Block the calling thread until some bytes are received.+-}+recv :: Socket -> MutableByteArray RealWorld -> Int -> Int -> MsgFlags -> IO Int+recv (unSocket -> sockfd) -- ^ A socket to receive messages from+ (MutableByteArray buf#) -- ^ Buffer to store message+ offs -- ^ Offset in bytes into the buffer+ size -- ^ Number of bytes allowed+ flags -- ^ Transmission flags+ = fmap fromIntegral $ I.recv# sockfd buf# (fromIntegral offs) (fromIntegral size) flags++-- | A version of `recv` that takes a pointer instead of a mutablebytearray+recv' :: Socket -> Ptr Word8 -> Int -> MsgFlags -> IO Int +recv' (unSocket -> sockfd) buf size = fmap fromIntegral . I.recv sockfd buf (fromIntegral size)++recvfromImpl :: Socket -> MutableByteArray RealWorld -> Int -> Int -> MsgFlags -> IO (Int, ByteArray)+recvfromImpl (unSocket -> sockfd) (MutableByteArray buf#) offs size flags = do+ addr@(MutableByteArray addr#) <- newSockAddrStorage+ addrlen <- getSizeofMutableByteArray addr+ with (fromIntegral addrlen) $ \ addrlen' -> do+ bytesRecv <-+ I.recvfrom# sockfd+ buf# (fromIntegral offs) (fromIntegral size)+ flags addr# addrlen'+ shrinkMutableByteArray addr . fromIntegral =<< peek addrlen'+ (fromIntegral bytesRecv,) <$> unsafeFreezeByteArray addr ++{-|+`recvfrom socket buffer offset size flags`+Receive a message less than `size` bytes long and the source address.+The bytes received are stored in `buffer` at `offset`+Return the number of bytes received.++(See `man 3 recvfrom`)+-}+recvfrom :: Socket -> MutableByteArray RealWorld -> Int -> Int -> MsgFlags -> IO (Int, Addr)+recvfrom sock -- ^ A socket to receive messages from+ buf -- ^ Buffer to store message+ offs -- ^ Offset in bytes into the buffer+ size -- ^ Number of bytes allowed+ flags -- ^ Transmission flags+ = fmap mkAddr <$> recvfromImpl sock buf offs size flags++-- | A version of `recvfrom` that takes a pointer+recvfrom' :: Socket -> Ptr Word8 -> Int -> MsgFlags -> IO (Int, Addr)+recvfrom' (unSocket -> sockfd) buf len flags = fmap mkAddr <$> do+ addr@(MutableByteArray addr#) <- newSockAddrStorage+ addrlen <- getSizeofMutableByteArray addr+ with (fromIntegral addrlen) $ \ addrlen' -> do+ bytesRecv <-+ I.recvfrom sockfd+ buf (fromIntegral len)+ flags addr# addrlen'+ shrinkMutableByteArray addr . fromIntegral =<< peek addrlen'+ (fromIntegral bytesRecv,) <$> unsafeFreezeByteArray addr ++-- | A version of recvfrom that automatically allocates a bytearray+recvsomefrom :: Socket -> Int -> MsgFlags -> IO (ByteArray, Addr)+recvsomefrom sock size flags = do+ buf <- newByteArray size+ (bytesRecv, addr) <- recvfromImpl sock buf 0 size flags+ shrinkMutableByteArray buf (fromIntegral bytesRecv)+ (, mkAddr addr) <$> unsafeFreezeByteArray buf++{- |+Receive messages alongside ancillary data.+The elements of `iovecs` are tuples containing the storage bytearray, offset into bytearray, and+the number of bytes to write to said bytearray.++(See `man 3 recvmsg`)+-}+recvmsg :: Socket -> [(MutableByteArray RealWorld, Int, Int)] -> Int -> MsgFlags -> IO (Int, MsgFlags, [AncillaryData], Addr)+recvmsg (unSocket -> sockfd) -- ^ The socket to recv message from+ (unzip3 -> (iovecs, map fromIntegral -> offs :: [CPtrdiff], map fromIntegral -> size :: [CSize])) -- ^ The storages buffers which will be filled from left to right. Semantics (Buffer, Offset(bytes), Size(Bytes))+ controllen -- ^ Maximum size of ancillary data in bytes.+ flags -- ^ Transmission flags+ = do+ control <- newCmsgBuffer controllen+ name@(MutableByteArray sockaddr#) + <- newSockAddrStorage+ namelen <- getSizeofMutableByteArray name+ (ArrayMutableByteArray iov#) <- primitive $ \ state0# -> + let !(# state1#, dummy# #) + = newByteArray# _0# state0# in+ let !(# state2#, mutarr# #)+ = newArray# iovlen# dummy# state1# in+ let !(State state4#, _)+ = foldl (\ (State state3#, idx@(I# idx#)) (MutableByteArray ba#) -> (State (writeArray# mutarr# idx# ba# state3#), idx + 1))+ (State state2#, 0)+ iovecs in+ let !(# state5#, arr# #)+ = unsafeFreezeArray# mutarr# state4# in+ (# state5#, ArrayMutableByteArray arr# #)+ (bytesRecv, newFlags, newControllen, newNamelen) <-+ withMutableByteArrayContents control $ \ control' ->+ with (fromIntegral controllen) $ \ controllen' ->+ with (fromIntegral namelen) $ \ namelen' ->+ with flags $ \ flags' -> do+ bytesRecv <- fromIntegral <$> + I.recvmsg# sockfd+ sockaddr# namelen'+ iov# offs# size# (fromIntegral iovlen)+ control' controllen'+ flags'+ newFlags <- peek flags'+ newControllen+ <- peek controllen'+ newNamelen <- peek namelen'+ return (bytesRecv, newFlags, newControllen, newNamelen)+ shrinkMutableByteArray name (fromIntegral newNamelen)+ shrinkMutableByteArray control (fromIntegral newControllen)++ frozenName <- unsafeFreezeByteArray name+ frozenControl <- unsafeFreezeByteArray control+ return (bytesRecv, newFlags, decodeAncillaryData frozenControl, mkAddr frozenName)+ where !iovlen@(I# iovlen#) = length iovecs+ !(I# _0#) = 0+ !(PrimArray offs#) = fromList offs+ !(PrimArray size#) = fromList size++-- | A version of `recvmsg` that does not return the address+recvmsg_ :: Socket -> [(MutableByteArray RealWorld, Int, Int)] -> Int -> MsgFlags -> IO (Int, MsgFlags, [AncillaryData])+recvmsg_ (unSocket -> sockfd) (unzip3 -> (iovecs, map fromIntegral -> offs :: [CPtrdiff], map fromIntegral -> size :: [CSize])) controllen flags = do+ control <- newCmsgBuffer controllen+ (MutableByteArray sockaddr#) + <- newByteArray 0+ let namelen = 0 + (ArrayMutableByteArray iov#) <- primitive $ \ state0# -> + let !(# state1#, dummy# #) + = newByteArray# _0# state0# in+ let !(# state2#, mutarr# #)+ = newArray# iovlen# dummy# state1# in+ let !(State state4#, _)+ = foldl (\ (State state3#, idx@(I# idx#)) (MutableByteArray ba#) -> (State (writeArray# mutarr# idx# ba# state3#), idx + 1))+ (State state2#, 0)+ iovecs in+ let !(# state5#, arr# #)+ = unsafeFreezeArray# mutarr# state4# in+ (# state5#, ArrayMutableByteArray arr# #)+ (bytesRecv, newFlags, newControllen) <-+ withMutableByteArrayContents control $ \ control' ->+ with (fromIntegral controllen) $ \ controllen' ->+ with namelen $ \ namelen' ->+ with flags $ \ flags' -> do+ bytesRecv <- fromIntegral <$> + I.recvmsg# sockfd+ sockaddr# namelen'+ iov# offs# size# (fromIntegral iovlen)+ control' controllen'+ flags'+ newFlags <- peek flags'+ newControllen+ <- peek controllen'+ return (bytesRecv, newFlags, newControllen)+ shrinkMutableByteArray control (fromIntegral newControllen)+ frozenControl <- unsafeFreezeByteArray control+ return (bytesRecv, newFlags, decodeAncillaryData frozenControl)+ where !iovlen@(I# iovlen#) = length iovecs+ !(I# _0#) = 0+ !(PrimArray offs#) = fromList offs+ !(PrimArray size#) = fromList size++-- | Shutdown all or part of of a duplex connection+shutdown :: Socket -> ShutHow -> IO ()+shutdown = I.shutdown . unSocket
+ test/codegen/Main.hs view
@@ -0,0 +1,10 @@+module Main where+import Netw.Inet+import System.Exit++main :: IO ()+main+ | and tests = exitSuccess+ | otherwise = exitFailure+ where tests = [ IPPORT_TCPMUX == 1+ , IPPORT_QOTD == 17 ]
+ test/msgs/Main.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+module Main (main) where+import Netw.Socket+import Netw.SockAddr++import Control.Monad++import Data.Bits+import Data.Word+import Data.Primitive++import System.Posix++import System.Exit++clientMain :: FilePath -> IO ()+clientMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ connect server addr+ + void (sendmsg server SockAddrNull [(msg, 0, sizeofByteArray msg)] [] zeroBits)++ closeSocket server+ where addr = SockAddrUn sunPath+ msg = [0, 1, 2, 3, 4, 5, 6, 7]++serverMain :: FilePath -> IO ()+serverMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ bind server addr+ listen server 1+ + client <- accept_ server+ buffer <- newByteArray 128+ (bytesRecv, _, _) <- recvmsg_ client [(buffer, 0, 128)] 0 zeroBits++ putStrLn $ "SERVER RECEIVED " ++ show bytesRecv ++ " BYTES"+ shrinkMutableByteArray buffer bytesRecv+ buffer' <- unsafeFreezeByteArray buffer+ printByteArray buffer'++ closeSocket client+ + removeLink sunPath+ closeSocket server+ where addr = SockAddrUn sunPath++printByteArray :: ByteArray -> IO ()+printByteArray ba = putStr str+ where str = foldrByteArray (\ (hex -> (h, l)) s -> '\\':'x':h:l:s) "" ba+ hex :: Word8 -> (Char, Char)+ hex w =+ let hex' = \case 0 -> '0'; 1 -> '1'; 2 -> '2'; 3 -> '3'+ 4 -> '4'; 5 -> '5'; 6 -> '6'; 7 -> '7'+ 8 -> '8'; 9 -> '9'; 10 -> 'a'; 11 -> 'b'+ 12 -> 'c'; 13 -> 'd'; 14 -> 'e'; 15 -> 'f'+ m -> hex' (m `mod` 16)+ in (hex' (w `div` 16), hex' (w `mod` 16))++main :: IO ()+main = do+ s <- forkProcess (serverMain sunPath)+ c <- forkProcess (clientMain sunPath)+++ serverExit <- maybe (fail "Server failure") return =<< getProcessStatus True True s+ clientExit <- maybe (fail "Client failure") return =<< getProcessStatus True True c++ case (serverExit, clientExit) of+ (Exited ExitSuccess, Exited ExitSuccess) -> exitSuccess+ _otherwise -> exitFailure+ where sunPath = "/run/user/1000/test"
+ test/send-and-recv-msgs/Main.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ViewPatterns #-}+module Main where+import Netw.Socket+import Netw.SockAddr ++import Control.Monad++import Data.Function+import Data.Primitive+import Data.Bits+import Data.Word++import System.Posix+import System.Exit+++messages :: [ByteArray]+messages = map mkByteArray [45, 742, 33, 554, 123, 74]+ where mkByteArray len = byteArrayFromListN @Word8 len (take len (cycle [0..]))+--messages =+-- [[0x03, 0xf1, 0x44, 0x11]+-- ,[0x5f, 0xc1, 0x02, 0xab]+-- ,[0x1c, 0xa2, 0xbf, 0x7d]+-- ,[0x33, 0x7d, 0x30, 0x0a]]++serverPath :: FilePath+serverPath = "/run/user/1000/unix-sock"++server :: IO ()+server = do+ servSock <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ bind servSock (SockAddrUn serverPath)+ listen servSock 1+ clieSock <- accept_ servSock+ + bufs <- mapM (\ (sizeofByteArray -> n) -> (, 0, n) <$> newByteArray n) messages+ fix (\ recvmore buffers nbytes ->+ let incrementBuffer 0 b = b+ incrementBuffer n (b:bs) =+ let (mba, offs, size) = b+ in if size > n+ then+ (mba, offs + n, size - n):bs+ else+ incrementBuffer (n - size) bs+ incrementBuffer n []+ | n == 0 = []+ | otherwise = error "Impossible"+ in when (nbytes > 0) $+ do+ (brecv, _, _) <- recvmsg_ clieSock buffers 0 zeroBits+ recvmore (incrementBuffer brecv buffers) (nbytes - brecv)) bufs (sum (sizeofByteArray <$> messages))+ receivedMessage <- mapM (\ (b, _, _) -> unsafeFreezeByteArray b) bufs+ + print (if receivedMessage == messages then "Success" else "Failure")++ closeSocket clieSock+ closeSocket servSock+ removeLink serverPath++client :: IO ()+client = do+ servSock <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ connect servSock (SockAddrUn serverPath)+ fix (\ sendmore buffers nbytes ->+ let incrementBuffer 0 b = b+ incrementBuffer n (b:bs) =+ let (mba, offs, size) = b+ in if size > n+ then+ (mba, offs + n, size - n):bs+ else+ incrementBuffer (n - size) bs+ incrementBuffer n []+ | n == 0 = []+ | otherwise = error "Impossible"+ in when (nbytes > 0) $+ do+ bsent <- sendmsg servSock SockAddrNull buffers [] zeroBits+ sendmore (incrementBuffer bsent buffers) (nbytes - bsent)) (map (\ b -> (b, 0, sizeofByteArray b)) messages) (sum (map sizeofByteArray messages))+ closeSocket servSock++main :: IO ()+main = do+ s <- forkProcess server+ c <- forkProcess client+ serverExit <- maybe (fail "Server failure") return =<< getProcessStatus True True s+ clientExit <- maybe (fail "Client failure") return =<< getProcessStatus True True c++ case (serverExit, clientExit) of+ (Exited ExitSuccess, Exited ExitSuccess) -> exitSuccess+ _otherwise -> exitFailure
+ test/server-client/Main.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedLists #-}+module Main (main) where++import Netw.Socket+import Netw.SockAddr++import Control.Monad++import Data.Function+import Data.Bits+import Data.Primitive++import System.Exit+import System.Posix++serverMain :: FilePath -> IO ()+serverMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ bind server addr+ listen server 1+ + client <- accept_ server+ fix (\ again -> do+ msg <- recvsome client 128 zeroBits+ if sizeofByteArray msg > 0+ then do+ putStrLn ("SERVER RECEIVED " ++ show (sizeofByteArray msg) ++ " BYTES")+ void (sendall client msg zeroBits)+ again+ else do+ putStrLn "SERVER EXIT"+ return ()+ )+ closeSocket client+ + removeLink sunPath+ closeSocket server+ where addr = SockAddrUn sunPath+ ++clientMain :: FilePath -> IO ()+clientMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ connect server addr+ void (sendall server [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15] zeroBits)+ msg <- recvsome server 128 zeroBits + putStrLn ("CLIENT RECEIVED " ++ show (sizeofByteArray msg) ++ " BYTES")+ closeSocket server+ where addr = SockAddrUn sunPath++main :: IO ()+main = do+ s <- forkProcess (serverMain sunPath)+ c <- forkProcess (clientMain sunPath)+ + serverExit <- maybe (fail "Server failure") return =<< getProcessStatus True True s+ clientExit <- maybe (fail "Client failure") return =<< getProcessStatus True True c++ case (serverExit, clientExit) of+ (Exited ExitSuccess, Exited ExitSuccess) -> exitSuccess+ _otherwise -> exitFailure+ where sunPath = "/run/user/1000/test"
+ test/unix-scm-rights/Main.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedLists #-}+module Main (main) where+import System.Posix.IO++import System.Posix.Process++import Netw.Socket+import Netw.SockAddr+import Netw.Ancillary++import Control.Monad++import Data.Bits+import Data.List+import Data.Primitive++import System.Posix+import System.Exit++serverMain :: FilePath -> IO ()+serverMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ bind server addr+ listen server 1+ + client <- accept_ server+ buffer <- newByteArray 8+ + (_, _, ancil) <- recvmsg_ client [(buffer, 0, 8)] 64 zeroBits+ let x :: Maybe ScmRights = (\ a -> ancillaryData a) . fst =<< uncons ancil+ y = case x of+ Nothing ->+ putStrLn "Failed to recv ancillary data"+ Just (ScmRights fds) -> do+ putStrLn "Received ancillary data"+ print fds+ y++ closeSocket client+ removeLink sunPath+ closeSocket server+ where addr = SockAddrUn sunPath+ ++clientMain :: FilePath -> IO ()+clientMain sunPath = do+ server <- socket PF_UNIX SOCK_STREAM DefaultProtocol+ connect server addr+ fd <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags+ void (sendmsg server SockAddrNull [([0], 0, 1)] [mkAncillaryData (ScmRights [fd])] zeroBits)+ closeSocket server+ where addr = SockAddrUn sunPath++main :: IO ()+main = do+ s <- forkProcess (serverMain sunPath)+ c <- forkProcess (clientMain sunPath)++ serverExit <- maybe (fail "Server failure") return =<< getProcessStatus True True s+ clientExit <- maybe (fail "Client failure") return =<< getProcessStatus True True c++ case (serverExit, clientExit) of+ (Exited ExitSuccess, Exited ExitSuccess) -> exitSuccess+ _otherwise -> exitFailure++ where sunPath = "/run/user/1000/test"