diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -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.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ 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.
+
+
+ Copyright (C)
+
+ 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 .
+
+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:
+
+ Copyright (C)
+ 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
+.
+
+ 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
+.
diff --git a/cbit/cmsg.c b/cbit/cmsg.c
new file mode 100644
--- /dev/null
+++ b/cbit/cmsg.c
@@ -0,0 +1,15 @@
+#include
+#include
+
+// 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);
+}
+
diff --git a/cbit/recv.c b/cbit/recv.c
new file mode 100644
--- /dev/null
+++ b/cbit/recv.c
@@ -0,0 +1,13 @@
+#include
+#include
+#include
+#include
+
+
+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);
+}
diff --git a/cbit/recvmsg.c b/cbit/recvmsg.c
new file mode 100644
--- /dev/null
+++ b/cbit/recvmsg.c
@@ -0,0 +1,57 @@
+#include
+#include
+#include
+#include
+
+#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;
+}
diff --git a/cbit/send.c b/cbit/send.c
new file mode 100644
--- /dev/null
+++ b/cbit/send.c
@@ -0,0 +1,10 @@
+#include
+#include
+#include
+#include
+
+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);
+}
diff --git a/cbit/sendmsg.c b/cbit/sendmsg.c
new file mode 100644
--- /dev/null
+++ b/cbit/sendmsg.c
@@ -0,0 +1,49 @@
+#include
+#include
+#include
+#include
+
+#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);
+}
diff --git a/cbit/socket.c b/cbit/socket.c
new file mode 100644
--- /dev/null
+++ b/cbit/socket.c
@@ -0,0 +1,29 @@
+#include
+#if __linux__
+#include
+
+#if LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,27)
+#define USE_LINUX_SOCK_NONBLOCK 1
+#endif
+
+#endif
+
+#if !USE_LINUX_SOCK_NONBLOCK
+#include
+#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
+}
diff --git a/cbit/static_assertion.c b/cbit/static_assertion.c
new file mode 100644
--- /dev/null
+++ b/cbit/static_assertion.c
@@ -0,0 +1,50 @@
+// This C file contains static_assertions and compile time check (using template haskell)
+#include
+#include
+#include
+
+// 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
+
diff --git a/netw.cabal b/netw.cabal
new file mode 100644
--- /dev/null
+++ b/netw.cabal
@@ -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
+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
+
diff --git a/src/Netw/Ancillary.hs b/src/Netw/Ancillary.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Ancillary.hs
@@ -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
diff --git a/src/Netw/Inet.hs b/src/Netw/Inet.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Inet.hs
@@ -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)
diff --git a/src/Netw/Internal.hs b/src/Netw/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal.hs
@@ -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
+
+
diff --git a/src/Netw/Internal/Ancillary.hsc b/src/Netw/Internal/Ancillary.hsc
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Ancillary.hsc
@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+module Netw.Internal.Ancillary where
+import GHC.TypeLits
+import Data.Proxy
+#include
+
+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
diff --git a/src/Netw/Internal/Cmsg.hsc b/src/Netw/Internal/Cmsg.hsc
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Cmsg.hsc
@@ -0,0 +1,71 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Netw.Internal.Cmsg where
+#include
+
+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
diff --git a/src/Netw/Internal/Enum.hsc b/src/Netw/Internal/Enum.hsc
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Enum.hsc
@@ -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
+#include
+
+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}
diff --git a/src/Netw/Internal/Port.hs b/src/Netw/Internal/Port.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Port.hs
@@ -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
diff --git a/src/Netw/Internal/Protocols.hs b/src/Netw/Internal/Protocols.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Protocols.hs
@@ -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)
diff --git a/src/Netw/Internal/Socket.hs b/src/Netw/Internal/Socket.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Socket.hs
@@ -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
diff --git a/src/Netw/Internal/Type.hsc b/src/Netw/Internal/Type.hsc
new file mode 100644
--- /dev/null
+++ b/src/Netw/Internal/Type.hsc
@@ -0,0 +1,106 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Netw.Internal.Type
+( Iovec(..)
+, sizeofSockaddrStorage
+, Protoent(..), protoents
+, Servent(..), servents
+, _IPPORT_RESERVED, _IPPORT_USERRESERVED
+) where
+#include
+#include
+
+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}
diff --git a/src/Netw/SockAddr.hsc b/src/Netw/SockAddr.hsc
new file mode 100644
--- /dev/null
+++ b/src/Netw/SockAddr.hsc
@@ -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
+#include
+#include
+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
diff --git a/src/Netw/Socket.hs b/src/Netw/Socket.hs
new file mode 100644
--- /dev/null
+++ b/src/Netw/Socket.hs
@@ -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
diff --git a/test/codegen/Main.hs b/test/codegen/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/codegen/Main.hs
@@ -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 ]
diff --git a/test/msgs/Main.hs b/test/msgs/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/msgs/Main.hs
@@ -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"
diff --git a/test/send-and-recv-msgs/Main.hs b/test/send-and-recv-msgs/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/send-and-recv-msgs/Main.hs
@@ -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
diff --git a/test/server-client/Main.hs b/test/server-client/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/server-client/Main.hs
@@ -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"
diff --git a/test/unix-scm-rights/Main.hs b/test/unix-scm-rights/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/unix-scm-rights/Main.hs
@@ -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"