packages feed

mptcpanalyzer (empty) → 0.0.2.0

raw patch · 53 files changed

+8873/−0 lines, 53 filesdep +Cabaldep +Chartdep +Chart-cairosetup-changed

Dependencies added: Cabal, Chart, Chart-cairo, Frames, HUnit, QuickCheck, aeson, aeson-extra, aeson-pretty, ansi-terminal, base, bytestring, cereal, containers, directory, filepath, foldl, formatting, ghci-dap, hashable, haskeline, haskell-dap, haskell-debug-adapter, hspec, ip, lens, mptcp, mptcp-pm, mptcpanalyzer, mtl, network, optparse-applicative, pipes, pipes-parse, pipes-safe, polysemy, polysemy-log, polysemy-log-co, polysemy-plugin, process, readable, template-haskell, temporary, text, time, transformers, unix, utf8-string, vector, vinyl, wide-word

Files

+ CHANGELOG view
@@ -0,0 +1,5 @@+# Revision history for mptcpanalyzer++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,674 @@+GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    {one line to give the program's name and a brief idea of what it does.}+    Copyright (C) {year}  {name of author}++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    {project}  Copyright (C) {year}  {fullname}+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ README.md view
@@ -0,0 +1,107 @@+<!-- BEGIN-MARKDOWN-TOC -->+* [Presentation](#presentation)+* [Installation](#installation)+* [Help](#faq)+* [Related tools](#related_tools)++<!-- END-MARKDOWN-TOC -->+++Presentation+===++Mptcpanalyzer is a tool conceived to help with MPTCP pcap analysis (as [mptcptrace] for instance).++It accepts packet capture files (\*.pcap) as inputs and from there you can:++- list MPTCP connections+- compute statistics on a specific MPTCP connection (list of subflows, reinjections, subflow actual contributions...)+- export a CSV file with MPTCP fields+- plot one way delays+- ...++Commands are self documented with autocompletion.+The interpreter with autocompletion that can generate & display plots such as the following:++```+cabal configure --enable-profiling+cabal run mptcpanalyzer "load-pcap examples/client_2_filtered.pcapng"  -- +RTS+-xc+```++# Installation++You will need a wireshark version __>= 3.6.0__ .++Until changes are upstreamed, you will need this fork of optparse-applicative+- https://github.com/teto/optparse-applicative/tree/quantum-wip-16.1+to get autocompletion working+++# How to use++mptcpanalyzer can run into 2 modes:+  1. interactive mode (default): an interpreter with some basic completion will accept your commands. There is also interactive help.+  2. otherwise, it will consider the unknow arguments as one command, the same that could be used interactively++For example, we can load mptcp pcaps (available at [wireshark wiki](https://wiki.wireshark.org/SampleCaptures#MPTCP) or in this [folder](./examples)).++```+mptcpanalyzer "map-tcp examples/client_2_filtered.pcapng examples/server_2_filtered.pcapng 0"+mptcpanalyzer "load-pcap examples/client_2_filtered.pcapng"+```++or for a live analysis:+```+plot-mptcp-live 10.0.0.1 10.0.0.2 33784 5201 client lo -f examples/client_2_cleaned_start.pcapng+```++See [this blog](http://teto.github.io/tags/mptcp.html) for more tutorials about mptcpanalyzer.++NB: in a local repository, you can run the previous command prefixed with+`mptcpanalyzer$ cabal run -- COMMAND`.++# How to develop/contribute++See [CONTRIBUTING](./CONTRIBUTING.md).++## Dependencies++- [polysemy](polysemy) to handle effects+- [Frames](frames) to analyze data+- [haskell-chart](haskell-chart) with the svg backend+- [wireshark](wireshark-mptcp) to convert packet captures (.pcapng) to csv files.+++# Roadmap++- improve caching+- improve autocompletion+- live statistics/plotting+- plugins ?+- ability to leverage the API in ihaskell ?++# Related tools++Similar software:++| Tool             | Description                                                                       |+|------------------------|-------------------------------------------------------------------------------|+| [mptcptrace]             | C based: [an example](http://blog.multipath-tcp.org/blog/html/2015/02/02/mptcptrace_demo.html)                                               |+| [mptcpplot]       | C based developed at NASA: [generated output example](https://roland.grc.nasa.gov/~jishac/mptcpplot/)                                                 |+++# Acknowledgements++This project is founded by ![NGI pointer](img/ngi_logo.png).++[mptcptrace]: https://bitbucket.org/bhesmans/mptcptrace+[mptcpplot]: https://github.com/nasa/multipath-tcp-tools/+[hk-img]: https://img.shields.io/hackage/v/mptcpanalyzer.svg?logo=haskell+[hk]: https://hackage.haskell.org/package/mptcpanalyzer+[replica]: https://github.com/berewt/REPLica+wireshark-mptcp: https://www.wireshark.org/docs/dfref/m/mptcp.html+polysemy: https://hackage.haskell.org/package/polysemy+diagrams: https://hackage.haskell.org/package/diagrams+frames: https://hackage.haskell.org/package/Frames+shelltestrunner: https://github.com/simonmichael/shelltestrunner
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"
+ mptcpanalyzer.cabal view
@@ -0,0 +1,359 @@+cabal-version: 3.0+name: mptcpanalyzer+version: 0.0.2.0+license: GPL-3.0-only+license-file: LICENSE+-- we need custom because of cabal-doctest+build-type: Simple+Author: Matthieu Coudron+Maintainer:  teto+Category:   Network+Synopsis: A Multipath TCP analyzer+Homepage:   https://github.com/teto/quantum+Description:+  __mptcpanalyzer__ is a multipath TCP (www.multipath-tcp.org) protocol analyzer.+  Multipath TCP is an extension of the Transmission Control Protocol that allows applications to send+  one single stream of data over multiple TCP connections.++  This software can automatically plot MPTCP characteristics such as Data Sequence Numbers, Data Acknowledgements etc.+  It can also map one packet capture to another to give more detailed statistics such+  as One-Way delays and reinjection qualifications.++  * list the MPTCP connections in the pcap+  * display chosen statistics on a specific MPTCP connection (list of subflows, number of reinjections, etc)+  * convert packet capture files (\*.pcap) to \*.csv files+  * plot data sequence numbers, dataacks for all subflows+  * can map packets between the client and server pcaps to plot one-way delays+    -- |prog| looks for files in certain directories. will try to load your configuration from `$XDG_CONFIG_HOME/mptcpanalyzer/config`+  -- TODO restore+  -- * caching mechanism: mptcpanalyzer compares your pcap creation time and will+    -- regenerate the cache if it exists in `$XDG_CACHE_HOME/mptcpanalyzer/<path_to_the_file>`+extra-doc-files:+    CHANGELOG+    README.md++extra-source-files:+  README.md CHANGELOG+  tests/integration/list-tcp.test+  -- benchmarks/*+tested-with:+  GHC == 8.10.7++Source-repository head+  type:       git+  location:   https://github.com/teto/quantum++Flag WithPolysemy {+  Description: Add polysemy plugin+  Default:     True+}++Flag Dev {+  Description: Relax constraints+  Default:     True+}++-- Flag ExtraChecks {+--   Description: Run some extra checks+--   Default:     True+-- }++-- aeson to (de)serialize to json+-- text is used to convert from string and in aeson+-- http://hackage.haskell.org/package/bitset-1.4.8/docs/Data-BitSet-Word.html+common shared-properties+    build-depends:+        base >= 4.12+      , ansi-terminal+      , aeson+      , aeson-pretty+      , aeson-extra+      , Cabal+      , Chart >= 1.5+      , Chart-cairo+      , Frames+      , bytestring+      -- , byteunits+      -- , time-units+      , cereal+      , containers+      , mptcp+      , directory+      , filepath+      , foldl+      , formatting+      , hashable+      , haskeline >= 0.8.0.0+      , ip+      , lens+      , mptcp-pm >= 0.0.4+      , mtl+      -- to talk with sharkd+      , network+      , optparse-applicative+      , pipes+      , pipes-parse+      , pipes-safe+      , polysemy+      , polysemy-log >= 0.2.2.4+      , polysemy-log-co+      , process+      , readable+      , template-haskell+      , temporary+      , text+      , time+      , unix+      , utf8-string+      , vector+      , vinyl+      , wide-word+      -- Debug Adapter Plugins (DAP)+      , haskell-dap+      , ghci-dap+      , haskell-debug-adapter+      -- , Chart-diagrams >= 1.5+      -- for plotting that's what is used in Frames+      -- polysemybased logger+    default-language: Haskell2010+    -- -fno-warn-unused-imports+    -- -fforce-recomp  makes it build twice+    if flag(WithPolysemy)+        ghc-options: -fplugin=Polysemy.Plugin+        build-depends: polysemy-plugin++    -- if flag(ExtraChecks)+    --     ghc-options: -DMPTCP_EXTRA_CHECKS++    if flag(Dev)+        cpp-options:+          -DDEBUG_CAPTURE=1+        ghc-options:+          -- -ddump-splices+          -- -ddump-to-file+          -- -ddump-timings+          -Wno-unused-imports+        -- build-depends: polysemy-plugin+          -fno-warn-unused-binds+          -fno-warn-unused-matches++    -- -ddump-splices to dump TH code+    ghc-options:+        -Wall+        -Werror=missing-methods+        -- -Werror=warn-missing-methods+        -Wpartial-fields+        -- -dth-dec-file+        -fwrite-ide-info+        -hiedir=.hie+        -haddock+        -- -fexternal-interpreter+        -- -fplugin=Polysemy.Plugin+    default-extensions:+        -- , OverloadedStrings+        FlexibleContexts+        , StrictData+        , DataKinds+        , FlexibleContexts+        , GADTs+        , LambdaCase+        , OverloadedStrings+        , PolyKinds+        , RankNTypes+        , ScopedTypeVariables+        , TemplateHaskell+        , TypeApplications+        , TypeOperators+        , TypeFamilies+++library+    import: shared-properties+    -- build-depends:+    --     aeson-extra++    -- visibility: public+    -- Other-modules:+    Exposed-Modules:+        Tshark.TH+        , Tshark.Fields+        , Tshark.Capture+        , Tshark.Interfaces+        , Tshark.Live+        , Tshark.Main+        , Tshark.Sharkd+        -- , Net.Mptcp.Types+        , Net.Tcp.Stats+        , Net.Mptcp.Stats+        -- , Net.Mptcp.Flags+        -- , Net.Mptcp.Connection+        -- reexport the rest+        , MptcpAnalyzer+        , MptcpAnalyzer.Prelude+        , MptcpAnalyzer.ArtificialFields+        , MptcpAnalyzer.Stream+        , MptcpAnalyzer.Stats+        , MptcpAnalyzer.Loader+        , MptcpAnalyzer.Frame+        , MptcpAnalyzer.Types+        , MptcpAnalyzer.Plots.Types+        , MptcpAnalyzer.Debug+        , MptcpAnalyzer.Pcap+        , MptcpAnalyzer.Cache+        , MptcpAnalyzer.Map+        , MptcpAnalyzer.Merge+        , MptcpAnalyzer.Units+        , MptcpAnalyzer.Plots+        , MptcpAnalyzer.Plots.Live+        , MptcpAnalyzer.Plots.Stream+        -- TODO remove les commandes ?+        -- , MptcpAnalyzer.Commands+        -- , MptcpAnalyzer.Commands.Load+        -- , MptcpAnalyzer.Commands.Export+        -- , MptcpAnalyzer.Commands.Utils+        -- , MptcpAnalyzer.Commands.List+        -- , MptcpAnalyzer.Commands.ListMptcp+        -- , MptcpAnalyzer.Commands.Plot+        -- TODO rename to Utils.Frames+        -- , MptcpAnalyzer.Frames.Utils+        , MptcpAnalyzer.Utils.Completion+        , MptcpAnalyzer.Utils.Text+        -- , Connection+    build-depends:+        Chart+        , Chart-cairo+        , transformers+    hs-source-dirs: src/+    ghc-options:+      -haddock++-- TODO add data-files+executable mptcpanalyzer+    import: shared-properties+    build-depends:+          mptcpanalyzer+        , ansi-terminal+        , transformers+        , lens+    Other-modules:+          Tshark.Live+        , Tshark.Interfaces+        , Tshark.Fields+        , Tshark.Main+        , Tshark.Sharkd+        -- , Net.Mptcp.Types+        -- reexport the rest+        , MptcpAnalyzer+        , MptcpAnalyzer.Frame+        , MptcpAnalyzer.Map+        , MptcpAnalyzer.Loader+        , MptcpAnalyzer.Types+        , MptcpAnalyzer.Plots.Types+        , MptcpAnalyzer.Debug+        , MptcpAnalyzer.Pcap+        , MptcpAnalyzer.Cache+        , MptcpAnalyzer.Stats+        , MptcpAnalyzer.Stream+        , MptcpAnalyzer.Merge+        , MptcpAnalyzer.ArtificialFields+        , MptcpAnalyzer.Commands+        , MptcpAnalyzer.Commands.Definitions+        , MptcpAnalyzer.Commands.Load+        , MptcpAnalyzer.Commands.Reinjections+        , MptcpAnalyzer.Commands.Export+        , MptcpAnalyzer.Commands.Plot+        , MptcpAnalyzer.Commands.PlotOWD+        , MptcpAnalyzer.Commands.Map+        , MptcpAnalyzer.Commands.List+        , MptcpAnalyzer.Commands.ListMptcp+        , MptcpAnalyzer.Commands.Plot+        , MptcpAnalyzer.Plots.Stream+        , MptcpAnalyzer.Plots.Live+        , MptcpAnalyzer.Prelude+        , MptcpAnalyzer.Units+        , MptcpAnalyzer.Utils.Completion+        , MptcpAnalyzer.Utils.Text+        , Net.Mptcp.Stats+        , Net.Tcp.Stats+        , Tshark.Capture+        , Tshark.TH+    -- for now reference mptcp-pm but later move part to a core+    -- build-depends: mptcp-pm >= 0.0.3+    main-is: app/Main.hs+    hs-source-dirs: src/+    -- ghc-options:+    --   -threaded -rtsopts -haddock++-- benchmark map-stream+--   type:             exitcode-stdio-1.0+--   main-is:          Map.hs+--   hs-source-dirs:   benchmarks+--   build-depends:+--       base+--       , Frames+--       -- criterion depends on optparse-applicative so be careful+--       -- to rely on 0.16.1 fork (master has breaking changes)+--       , criterion+--       , mptcpanalyzer:mptcpanalyzer+--       , polysemy+--       , polysemy-log >= 0.2.2.4+--       , polysemy-log-co++--   ghc-options:+--   default-language: Haskell2010+++Test-Suite test+  type:               exitcode-stdio-1.0+  main-is:+    Spec.hs+  hs-source-dirs:     tests+  default-language: Haskell2010+  default-extensions:+      -- , OverloadedStrings+      FlexibleContexts+    , StrictData+    , DataKinds+  other-modules:+      Tshark.MainSpec+    , Net.Tcp.StatsSpec+    , MptcpAnalyzer.PcapSpec+    , MptcpAnalyzer.LoaderSpec+    , MptcpAnalyzer.MapSpec+    , Utils+  build-depends:+      base >=4.12 && <4.20+    , Cabal+    , HUnit+    , hspec+    , QuickCheck+    , mptcp+    , mptcpanalyzer+    , ip+    , Frames+    , polysemy+    , polysemy-log >= 0.2.2.4+    , polysemy-log-co+  ghc-options:+    -Wall+    -threaded +++-- doctests are a pain+-- test-suite doctests+--   type:             exitcode-stdio-1.0+--   main-is:          doctests.hs+--   build-depends:+--       base+--     , base-compat       >=0.10.5 && <0.12+--     , doctest           >=0.15   && <0.18+--     , QuickCheck        >=2.12   && <2.15+--     , template-haskell+--     , mptcpanalyzer+--   -- there are several custom packages+--   -- exe:example+--   -- x-doctest-components:+--   --   lib:mptcpanalyzer+--   ghc-options:      -Wall -threaded+--   hs-source-dirs:   tests+--   default-language: Haskell2010
+ src/MptcpAnalyzer.hs view
@@ -0,0 +1,22 @@+{-|+Module      : MptcpAnalyzer+Description : Top level module+Maintainer  : matt+License     : GPL-3+++* Tutorial++How to use ?+-}+module MptcpAnalyzer (+  -- * Core Types++  module X+)+where+import MptcpAnalyzer.Cache as X+import MptcpAnalyzer.Frame as X+import MptcpAnalyzer.Loader as X+import MptcpAnalyzer.Types as X+import MptcpAnalyzer.Utils.Completion as X
+ src/MptcpAnalyzer/ArtificialFields.hs view
@@ -0,0 +1,62 @@+{-|+Module      : MptcpAnalyzer.ArtificialFields+Description : A set of artifical fields to ease dataframe processing+Maintainer  : matt+++generated in a postprocess step++-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+module MptcpAnalyzer.ArtificialFields+where+import MptcpAnalyzer.Stream++import Net.IP+-- import Net.IPv6 (IPv6(..))+import GHC.TypeLits (KnownSymbol)+-- import Language.Haskell.TH (Name)+import Data.Map (Map, fromList)+import Data.String+import Data.Text (Text)+import Data.Word (Word16, Word32, Word64, Word8)+import Frames.ShowCSV+import Language.Haskell.TH (Name)+import Options.Applicative+import Tshark.Fields++-- | Filters a connection depending on its role+data ConnectionRole = RoleServer | RoleClient deriving (Show, Eq, Enum, Read, ShowCSV, Ord)++showConnectionRole :: (IsString a) => ConnectionRole -> a+showConnectionRole RoleServer = "Server"+showConnectionRole RoleClient = "Client"++artificialFields :: FieldDescriptions+artificialFields = fromList [+    ("tcpDest", TsharkFieldDesc "" ''ConnectionRole Nothing False)+    , ("mptcpDest", TsharkFieldDesc "" ''ConnectionRole Nothing False)+    , ("conDest", TsharkFieldDesc "" ''ConnectionRole Nothing False)+    , ("packetHash", TsharkFieldDesc "" ''ConnectionRole Nothing False)+  ]++-- TODO remove+-- mergedFields :: [(Text, Name)]+-- mergedFields = [+--   ("senderIP", ''IP)+--   , ("receiverIP", ''IP)+--   , ("sndTime", ''Double)+--   , ("rcvTime", ''Double)+--   , ("tcpSeq", ''Word32)+--   ]+++readConnectionRole :: ReadM ConnectionRole+readConnectionRole = eitherReader $ \arg -> case arg of+  "server" -> return RoleServer+  "client" -> return RoleClient+  -- [("client", "")] -> return $ RoleClient+  _other -> Left $ "readConnectionRole: cannot parse value `" ++ arg ++ "`. It must be either 'server' or 'client'"
+ src/MptcpAnalyzer/Cache.hs view
@@ -0,0 +1,150 @@+{-|+Module      : MptcpAnalyzer.Cache+Description : Save into/load from a local cache+Maintainer  : matt+License     : GPL-3+-}++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+module MptcpAnalyzer.Cache (+  CacheId(..)+  , Cache(..)+  , CacheConfig(..)+  , runMockCache+  , getCache+  , putCache+  , runCache+)+where++import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Types++import Prelude hiding (writeFile)+import System.Directory (doesFileExist)+-- import System.Posix.Files.ByteString+import Control.Exception as CE+import Data.ByteString (writeFile)+import Data.Hashable+import Data.List (intercalate)+import Data.Serialize+import Frames+import Frames.CSV+import GHC.Generics+import Polysemy+import System.FilePath.Posix (takeBaseName)+++-- | Cache item identifier+data CacheId = CacheId {+  cacheDeps :: [FilePath]+  , cachePrefix :: String+  , cacheSuffix :: String+} deriving (Generic, Show, Eq, Hashable)++-- | Cache config (this is a test)+-- test+data CacheConfig = CacheConfig {+  -- | Folder where to store stuff+  cacheFolder :: FilePath+  -- | Whether the cachie is fixed+  , cacheEnabled :: Bool+} deriving Show++-- class Serializable a where+--   encode :: a -> String+--   decode :: String -> a++-- TODO add a cacheConfig ?+-- TODO this should be an effect+data Cache m a where+    -- should maybe be a filepath+    PutCache :: Serialize res => CacheId -> res -> Cache m Bool+    GetCache :: Serialize res => CacheId -> Cache m (Either String res)+    IsValid :: CacheId -> Cache m Bool++makeSem ''Cache++filenameFromCacheId :: CacheId -> FilePath+filenameFromCacheId cid =+    cachePrefix cid ++ intercalate "_" basenames ++ show myHash ++ cacheSuffix cid+    where+        basenames = map takeBaseName $ cacheDeps cid+        -- TODO+        -- "hash"+        myHash = hash basenames++-- Return full path to the config folder+getFullPath :: CacheConfig -> CacheId -> FilePath+getFullPath config cid = cacheFolder config ++ "/" ++ filenameFromCacheId cid+++-- TODO pass cache config+runCache :: Members '[Embed IO] r => CacheConfig -> Sem (Cache : r) a -> Sem r a+runCache config = do+  interpret $ \case+      PutCache cid frame -> doPutCache config cid frame+      GetCache cid -> doGetCache config cid+        -- return $ Left "not implemented"+        -- use config to get the final path too+        -- let csvFilename = filenameFromCacheId cid+        -- rpcap <- embed $ loadRows csvFilename+        -- return Right rpcap+      IsValid cid -> isCacheValid config cid++-- | Mock cache+--+runMockCache :: Members '[Embed IO] r => CacheConfig -> Sem (Cache : r) a -> Sem r a+runMockCache config = do+  interpret $ \case+      PutCache cid frame -> return True+      GetCache cid -> return $ Left "Not in cache"+        -- return $ Left "not implemented"+        -- use config to get the final path too+        -- let csvFilename = filenameFromCacheId cid+        -- rpcap <- embed $ loadRows csvFilename+        -- return Right rpcap+      IsValid cid -> return False++-- first check if the file exists ?+doGetCache :: (Serialize a, Members '[Embed IO] r)+  => CacheConfig+  -> CacheId+  -> Sem r (Either String a)+doGetCache config cid = return $ Left "Not implemented yet"+  -- do+  -- -- res <- embed $ loadRows csvFilename+  -- -- exists <- embed $ fileExist csvFilename+  -- res <- embed $ CE.try @IOException $ loadRows csvFilename+  -- case res of+  --   Left _excpt -> return $ Left "Exception"+  --   Right x -> return (Right x)+  -- where+  --     csvFilename = getFullPath config cid+++-- TODO reuse export function ?+doPutCache :: (Serialize a, Members '[Embed IO] r)+  => CacheConfig -> CacheId -> a -> Sem r Bool+doPutCache config cid resource =+  -- writeFile+  -- writeCSV :: (ColumnHeaders ts, Foldable f, RecordToList ts, RecMapMethod ShowCSV ElField ts) => FilePath -> f (Record ts) -> IO ()+  -- produceDSV+  -- embed $ writeCSV csvFilename frame >> return True+  embed $ do+    writeFile csvFilename $ encode resource+    return True+  where+      csvFilename = getFullPath config cid+++-- TODO log ? / compare inputs date+isCacheValid :: Members '[Embed IO] r => CacheConfig -> CacheId -> Sem r Bool+isCacheValid config cid =+  embed $ doesFileExist filename+  where+    filename = getFullPath config cid
+ src/MptcpAnalyzer/Commands.hs view
@@ -0,0 +1,25 @@+{-+Module:  MptcpAnalyzer.Commands+Description :  Description+Maintainer  : matt+Portability : Linux+-}+module MptcpAnalyzer.Commands (+  module MptcpAnalyzer.Commands.Load+  , module MptcpAnalyzer.Commands.Export+)+where+import Polysemy (Members, Sem, interpret)+import qualified Polysemy.Embed as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import qualified Polysemy.State as P++import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions+import MptcpAnalyzer.Commands.Export+import qualified MptcpAnalyzer.Commands.List as CL+import qualified MptcpAnalyzer.Commands.ListMptcp as CL+import MptcpAnalyzer.Commands.Load+import qualified MptcpAnalyzer.Commands.Plot as PL+import MptcpAnalyzer.Types
+ src/MptcpAnalyzer/Commands/Definitions.hs view
@@ -0,0 +1,84 @@+module MptcpAnalyzer.Commands.Definitions (+  RetCode(..)+  , CommandMapPcap (..)+  , CommandArgs (..)+  , parserPcapMapping+)+where+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Plots.Types+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types++import Data.Word (Word32)+import MptcpAnalyzer.Utils.Completion (completePath, readFilename)+import Options.Applicative+++-- | Mapping streams between 2 pcaps is something common in this program.+-- This structure avoids copy/paste.+data CommandMapPcap = CommandMapPcap {+  argsMapPcap1 :: FilePath+  , argsMapPcap2 :: FilePath+  , argsMapStream :: Word32+  , argsMapVerbose :: Bool+  , argsMapLimit :: Int -- ^Number of comparisons to show+  -- , argsMapMptcp :: Bool -- ^Wether it's an MPTCP+}++-- | Registered commands+-- TODO make it possible to add some from a plugin+data CommandArgs =+    ArgsLoadCsv FilePath Bool+    | ArgsHelp+    | ArgsQuit+    | ArgsLoadPcap FilePath+    | ArgsListTcpConnections Bool  -- ^ Detailed+    | ArgsListMpTcpConnections Bool  -- ^ Detailed+    | ArgsMapTcpConnections CommandMapPcap Bool+    -- ^ Pcap 1 Pcap 2 streamId1 verbose Limit Mptcp+    -- | ArgsMapMptcpConnections FilePath FilePath Word32 Bool Int Bool+    | ArgsListSubflows Bool+    | ArgsListInterfaces+      -- ^ _listSubflowsDetailed+    | ArgsListReinjections (StreamId Mptcp)+    | ArgsTcpSummary Bool (StreamId Tcp)+    | ArgsTcpSummaryFromFile FilePath +      -- Bool (StreamId Tcp)+    | ArgsMptcpSummary Bool (StreamId Mptcp)+    | ArgsExport FilePath   -- ^ argsExportFilename+    -- | plotOut+    -- Bool Whether we have to display+    -- Bool Whether it's TCP+    | ArgsPlotGeneric PlotSettings ArgsPlots+    | ArgsQualifyReinjections (PcapMapping Mptcp) Bool++-- | Return code for user command. Whether to exit program or keep going+data RetCode = Exit | Error String | Continue++parserPcapMapping :: Bool -> Parser (PcapMapping a)+parserPcapMapping forMptcp =+  -- if forMptcp then+    PcapMapping <$>+  -- else+  --   ArgsMapMptcpConnections <$> toto+  -- where+  -- toto =+      strArgument (+          metavar "PCAP1"+          <> completer completePath+          <> help "File to analyze"+      )+      <*> argument readStreamId (+          metavar "TCP_STREAM"+          <> help "stream id to analyzer"+      )+      <*> strArgument (+          metavar "PCAP2"+          <> completer completePath+          <> help "File to analyze"+      )+      <*> argument readStreamId (+          metavar "TCP_STREAM"+          <> help "stream id to analyzer"+      )
+ src/MptcpAnalyzer/Commands/Export.hs view
@@ -0,0 +1,43 @@+module MptcpAnalyzer.Commands.Export (+  piExportOpts+  , cmdExport+)+where++import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Types++import Control.Lens (view, (^.))+import Frames.CSV (writeCSV)+import Options.Applicative+import Polysemy (Embed, Members, Sem)+import Polysemy.State as P+import Prelude hiding (log)++piExportOpts ::  ParserInfo CommandArgs+piExportOpts = info (+   ArgsExport <$> parserList <**> helper)+  ( progDesc "Filename to export to"+  )+  where+    -- _exportFilename+    parserList = argument str (metavar "PCAP" <> completeWith ["toto", "tata"]+          <> help "Load a Csv file"+      )++{-| Export loaded file+-}+cmdExport :: Members '[P.State MyState, Cache, Embed IO] r+    => FilePath+    -> Sem r RetCode+cmdExport args = do+  -- state <- P.get+  return Continue+  -- let loadedPcap = view loadedFile state+  -- fmap writeToCSV loadedPcap >>= \case+  --   Just True -> return Continue+  --   _ -> return $ Error "test"+  -- where+  --   writeToCSV frame = writeCSV (_exportFilename args) frame >> return True
+ src/MptcpAnalyzer/Commands/List.hs view
@@ -0,0 +1,294 @@+{-|++Module      : MptcpAnalyzer.Commands.List+Description : List (MP)TCP connections in a pcap+Maintainer  : matt++-}+{-# LANGUAGE PackageImports #-}++module MptcpAnalyzer.Commands.List (+    piListTcpOpts+  , piTcpSummaryOpts+  , piMptcpSummaryOpts+  , cmdListTcpConnections+  , cmdTcpSummary+  , cmdTcpSummarySharkd+  , cmdMptcpSummary+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stats+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Net.Mptcp+import Net.Mptcp.Stats+import Net.Tcp+import Net.Tcp.Stats+import Net.Tcp.Constants (TcpFlag(..))+import Tshark.Sharkd++import Control.Lens hiding (argument)+import Data.Either (fromRight)+import Data.List (intercalate)+import qualified Data.Map as Map+import Frames+import qualified Frames as F+import Frames.CSV+import qualified Frames.InCore as F+import Options.Applicative+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import qualified Polysemy.State as P+import Polysemy.Trace as P+import Prelude hiding (log)++piListTcpOpts ::  ParserInfo CommandArgs+piListTcpOpts = info (+   ArgsListTcpConnections <$> parserList <**> helper)+  ( progDesc "List subflows of an MPTCP connection"+  )+  where+    parserList = switch (long "detailed" <> help "detail connections")++piTcpSummaryOpts :: ParserInfo CommandArgs+piTcpSummaryOpts = info (+   piTcpSummary <**> helper)+  ( progDesc "Detail a specific TCP connection"+    <> footer "Example: summary 0"+  )+  where+    piTcpSummary :: Parser CommandArgs+    piTcpSummary = ArgsTcpSummary <$> switch+              ( long "full"+            <> help "Print details for each subflow" )+          <*> argument readStreamId (+              metavar "STREAM_ID"+              <> help "Stream Id (tcp.stream)"+              -- TODO pass a default+              )++++piMptcpSummaryOpts :: ParserInfo CommandArgs+piMptcpSummaryOpts = info (+   piMptcpSummary <**> helper)+  ( progDesc "Detail a specific TCP connection"+  <> footer "mptcp-summary 0"+  )+  where+    piMptcpSummary :: Parser CommandArgs+    piMptcpSummary = ArgsMptcpSummary <$> switch+              ( long "full"+            <> help "Print details for each subflow" )+          <*> argument readStreamId (+              metavar "STREAM_ID"+              <> help "Stream Id (mptcp.stream)"+              -- TODO pass a default+              )++{-| Show a list of all connections++@+8 tcp connection(s)+  tcp.stream 0: 10.0.0.1:33782 -> 10.0.0.2:05201+  tcp.stream 1: 10.0.0.1:33784 -> 10.0.0.2:05201+  tcp.stream 2: 10.0.0.1:54595 -> 11.0.0.2:05201+  tcp.stream 3: 10.0.0.1:57491 -> 11.0.0.2:05201+  tcp.stream 4: 11.0.0.1:59555 -> 11.0.0.2:05201+  tcp.stream 5: 11.0.0.1:50077 -> 11.0.0.2:05201+  tcp.stream 6: 11.0.0.1:35589 -> 10.0.0.2:05201+  tcp.stream 7: 11.0.0.1:50007 -> 10.0.0.2:05201+@+-}+cmdListTcpConnections ::+  (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+  => Bool -- ^ detailed+  -> Sem r RetCode+cmdListTcpConnections listDetailed = do+    -- TODO this part should be extracted so that+    state <- P.get+    let loadedPcap = view loadedFile state+    case loadedPcap of+      Nothing -> do+        trace "please load a pcap first"+        return CMD.Continue+      Just frame -> do+        let tcpStreams = getTcpStreams frame+        let streamIdList = if listDetailed then [] else tcpStreams+        -- log $ "Number of rows " ++ show (frameLength frame)+        P.trace $ "Number of TCP connections " ++ show (length tcpStreams)+        -- TODO use a trace there+        mapM_ (P.trace . describeConnection) streamIdList+        return CMD.Continue+        where+          describeConnection streamId =+            case buildTcpConnectionFromStreamId frame streamId of+              Left msg -> msg+              Right aframe -> showConnection (ffCon aframe)+++{-| Display statistics for the connection:+throughput/goodput++detailed+-}+cmdTcpSummary :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+  => StreamId Tcp+  -> Bool+  -> Sem r RetCode+cmdTcpSummary streamId detailed = do+    state <- P.get+    let loadedPcap = view loadedFile state+    case loadedPcap of+      Nothing -> return $ CMD.Error "please load a pcap first"+      Just frame -> case buildTcpConnectionFromStreamId frame streamId of+        Left msg -> return $ CMD.Error msg+        Right aframe -> do+          -- let _tcpstreams = getTcpStreams frame+          P.trace $ showConnection (ffCon aframe)+          Log.info $ "Number of rows "  <> tshow (frameLength $ ffFrame aframe)+          if detailed+          then do+            res <- showStats aframe RoleServer+            P.trace res+            res2 <- showStats aframe RoleClient+            P.trace res2+          else+            pure ()+          return CMD.Continue++{-| Display statistics for the connection:+throughput/goodput++detailed+-}+cmdTcpSummarySharkd :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+  => FilePath+  -> StreamId Tcp+  -> Bool+  -> Sem r RetCode+cmdTcpSummarySharkd pcapPath streamId detailed = do+    P.embed $ loadFile pcapPath defaultSocketPath >> return CMD.Continue+    -- TODO then ask for the stats about that TCP flow+    --+    -- state <- P.get+    -- let loadedPcap = view loadedFile state+    -- case loadedPcap of+    --   Nothing -> return $ CMD.Error "please load a pcap first"+    --   Just frame -> case buildTcpConnectionFromStreamId frame streamId of+    --     Left msg -> return $ CMD.Error msg+    --     Right aframe -> do+    --       -- let _tcpstreams = getTcpStreams frame+    --       P.trace $ showConnection (ffCon aframe)+    --       Log.info $ "Number of rows "  <> tshow (frameLength $ ffFrame aframe)+    --       if detailed+    --       then do+    --         res <- showStats aframe RoleServer+    --         P.trace res+    --         res2 <- showStats aframe RoleClient+    --         P.trace res2+    --       else+    --         pure ()+    --       return CMD.Continue+++-- | Show stats in both directions+showStats :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+  => FrameFiltered TcpConnection Packet+  -> ConnectionRole+  -> Sem r String+showStats aframe dest = let+    aframeWithDest = addTcpDestinationsToAFrame aframe+    tcpStats = getTcpStatsFromAFrame aframeWithDest dest++    destFrame = F.filterFrame (\x -> x ^. tcpDest == dest) (ffFrame aframeWithDest)++  in do+    P.embed $ writeDSV defaultParserOptions ("debug-" ++ show dest ++ ".csv") destFrame+    return $ showTcpStats tcpStats ++ "   (" ++ show (frameLength destFrame) ++ " packets)"+++-- | summarize a few key characteristics like goodput/throughput+showTcpStats :: TcpUnidirectionalStats -> String+showTcpStats s =+                  "- transferred " ++ show (tusSndNext s - tusMinSeq s + 1 + tusReinjectedBytes s)  ++ " bytes "+                  ++ " over " ++ show (tusEndTime s - tusStartTime s) ++ "s: "+                  ++ " Throughput " ++ show (getTcpThroughput s) ++ "b/s"+++{-+Returns something+mptcp stream 0 transferred 469.0 Bytes over 45.831181 sec(456.0 Bytes per second) towards Server.+tcpstream 0 transferred 460.0 Bytes out of 469.0 Bytes, accounting for 98.08%+tcpstream 2 transferred 9.0 Bytes out of 469.0 Bytes, accounting for 1.92%+tcpstream 4 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%+tcpstream 6 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%+-}+showMptcpStats :: MptcpUnidirectionalStats -> String+showMptcpStats s = unlines [+    " Mptcp stats towards " ++ show (musDirection s) ++ " :"+    , "- Duration " ++ show (getMptcpStatsDuration s)+    , "- Goodput " ++ show (getMptcpGoodput s)+    , "<TODO>\n"+    , "Applicative Bytes : " ++ show (musApplicativeBytes s)+    , "Subflow stats:"+    , intercalate "\n" (map showSubflowStats (Map.toList $ musSubflowStats s))+    ]+    where+      -- ++ show (tusStreamId)+      showSubflowStats (sf, sfStats) = let+          tcpStats = tssStats sfStats+          seqRange = getTcpSeqRange tcpStats+          totalApplicationBytes = musApplicativeBytes s+        in "stream " ++ show (conTcpStreamId (sfConn sf))+          ++ ": transferred " ++ show seqRange ++ " out of " ++ show totalApplicationBytes+          ++ " between "+          ++ show (tusStartTime tcpStats) ++ " end time: " ++ show (tusEndTime $ tssStats sfStats)+          ++ " , accouting for " ++ show (seqRange / fromIntegral totalApplicationBytes) ++ " %"++{-+Returns:+mptcp stream 0 transferred 308.0 Bytes over 45.658558 sec(308.0 Bytes per second) towards Client.+tcpstream 0 transferred 308.0 Bytes out of 308.0 Bytes, accounting for 100.00%+tcpstream 2 transferred 0.0 Bytes out of 308.0 Bytes, accounting for 0.00%+tcpstream 6 transferred 0.0 Bytes out of 308.0 Bytes, accounting for 0.00%+mptcp stream 0 transferred 469.0 Bytes over 45.831181 sec(456.0 Bytes per second) towards Server.+tcpstream 0 transferred 460.0 Bytes out of 469.0 Bytes, accounting for 98.08%+tcpstream 2 transferred 9.0 Bytes out of 469.0 Bytes, accounting for 1.92%+tcpstream 4 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%+tcpstream 6 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%+-}+cmdMptcpSummary :: (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+  => StreamId Mptcp+  -> Bool+  -> Sem r RetCode+cmdMptcpSummary streamId detailed = do+  state <- P.get+  case view loadedFile state of+    Nothing -> trace ("please load a pcap first" :: String) >> return CMD.Continue+    Just frame -> case buildMptcpConnectionFromStreamId frame streamId of+      Left msg -> return $ CMD.Error msg+      Right aframe -> do++        let mptcpStatsClient = getMptcpStats aframe RoleClient+        let mptcpStatsServer = getMptcpStats aframe RoleServer++        P.trace $ showConnection (ffCon aframe)+        Log.debug $ "Number of rows " <> tshow (frameLength frame)+        if detailed+        then+          -- RoleServer+          P.trace $ showMptcpStats mptcpStatsClient+          -- trace $ showMptcpStats mptcpStatsServer+        else+          pure ()+        return CMD.Continue
+ src/MptcpAnalyzer/Commands/ListMptcp.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+module MptcpAnalyzer.Commands.ListMptcp (+  piListMpTcpOpts+  , cmdListMptcpConnections+  , cmdListSubflows+)+where++import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Commands.List as CMD+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import Net.Mptcp++-- import Net.Mptcp.Types (MptcpConnection(..), MptcpSubflow, showMptcpConnection)++import qualified Control.Foldl as L+import Control.Lens hiding (argument)+import Data.Either (fromRight)+import Data.Maybe (catMaybes, fromJust)+import qualified Data.Set as Set+import Data.Word (Word16, Word32, Word64, Word8)+import Frames+import "mptcp-pm" Net.Tcp.Constants (TcpFlag(..))+import Options.Applicative+import qualified Pipes.Prelude as PP+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import Polysemy.State as P+import Polysemy.Trace as P++import Polysemy.Log (Log)+import qualified Polysemy.Log as Log++piListMpTcpOpts :: ParserInfo CommandArgs+piListMpTcpOpts = info (+    parserList <**> helper)+  ( progDesc "List MPTCP connections"+  )+  where+    parserList = ArgsListMpTcpConnections <$> switch ( long "detailed" <> help "detail connections")++piListMptcpSubflowOpts :: ParserInfo CommandArgs+piListMptcpSubflowOpts = info (+    parserList <**> helper)+  ( progDesc "List MPTCP connections"+  )+  where+    parserList = ArgsListSubflows <$> switch ( long "detailed" <> help "detail connections")+++-- piListMptcpReinjectionsOpts :: ParserInfo CommandArgs+-- piListMptcpReinjectionsOpts = info (+--     parserList <**> helper)+--   ( progDesc "List MPTCP reinjections"+--   )+--   where+--     parserList = ArgsListSubflows <$> switch ( long "detailed" <> help "detail connections")++type SomeFrame = Frame Packet++-- TODO return mpconStreamId instead+getMpTcpStreams :: SomeFrame -> [StreamIdMptcp]+getMpTcpStreams ps =+    catMaybes $+    L.fold L.nub (view mptcpStream <$> ps)++filterMptcpConnection :: SomeFrame -> StreamId Mptcp -> SomeFrame+filterMptcpConnection frame streamId =+  streamPackets+  where+    streamPackets = filterFrame  (\x -> x ^. mptcpStream == Just streamId) frame+++++-- buildMptcpConnectionFromRow :: Packet -> TcpConnection+-- buildMptcpConnectionFromRow r =+  -- MptcpConnection {+    -- srcIp = r ^. ipSource+    -- , dstIp = r ^. ipDest+    -- , srcPort = r ^. tcpSrcPort+    -- , dstPort = r ^. tcpDestPort+    -- , priority = Nothing  -- for now+    -- , localId = 0+    -- , remoteId = 0+    -- , subflowInterface = Nothing+  -- }++++cmdListSubflows :: (Members '[Log, P.State MyState, P.Trace, Cache, Embed IO] r)+  => Bool -- ^ Detailed+  -> Sem r RetCode+cmdListSubflows detailed = do+  P.trace "not implemented yet"+  return CMD.Continue++{-+-}+cmdListMptcpConnections ::+  (Members [Log, P.Trace, P.State MyState, Cache, P.Embed IO] r)+  => Bool -- ^ Detailed+  -> Sem r RetCode+cmdListMptcpConnections _detailed = do+    -- TODO this part should be extracted so that+    state <- P.get+    let loadedPcap = view loadedFile state+    case loadedPcap of+      Nothing -> do+        P.trace "please load a pcap first"+        return CMD.Continue+      Just frame -> do+        -- log $ "Number of rows " ++ show (frameLength frame)+        P.trace $ "Number of MPTCP connections " ++ show (length mptcpStreams)+        P.trace $ show mptcpStreams+        P.trace $ concatMap showEitherCon mptcpConnections+        -- >>+        return CMD.Continue+        where+          mptcpConnections :: [Either String MptcpConnection]+          mptcpConnections = map (fmap ffCon . buildMptcpConnectionFromStreamId frame ) mptcpStreams++          showEitherCon :: Either String MptcpConnection -> String+          showEitherCon (Left msg) = msg ++ "\n"+          showEitherCon (Right mptcpCon) = showConnection mptcpCon ++ "\n"++          mptcpStreams = getMpTcpStreams frame+
+ src/MptcpAnalyzer/Commands/Load.hs view
@@ -0,0 +1,106 @@+{-|+Module: MptcpAnalyzer.Commands.Load+Maintainer  : matt+License     : GPL-3+-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+module MptcpAnalyzer.Commands.Load (+    cmdLoadCsv+  , piLoadCsv+  , piLoadPcapOpts+  , filenameReader+)+where+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Completion (completePath, readFilename)+import MptcpAnalyzer.Utils.Text++-- import Control.Lens hiding (argument)++import Control.Monad.Trans (liftIO)+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import Frames+import Options.Applicative+import System.Exit (ExitCode(..))+-- import Prelude hiding (log)+import Options.Applicative.Builder (allPositional)+import Polysemy (Embed, Members, Sem)+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import qualified Polysemy.State as P+import qualified Polysemy.Trace as P++import Control.Monad.Trans.Except+       (ExceptT(..), runExcept, runExceptT, throwE, withExcept)++filenameReader :: ReadM FilePath+filenameReader = eitherReader readFilename+-- case readFilename filename of+--   Left err -> ReadM . lift . throwE+--   Right path -> path++-- (eitherReader readFilename)+loadPcapArgs :: Parser CommandArgs+loadPcapArgs =  ArgsLoadPcap <$>+  argument filenameReader (metavar "PCAP"+    <> completer completePath+    <> help "Load a Pcap file"+  )++cmdLoadCsvArgs :: Parser CommandArgs+cmdLoadCsvArgs =  ArgsLoadCsv <$> (+    argument str (+      metavar "CSV"+      -- <> action "file"+      <> completer completePath+      <> help "Load a Csv file"+    ))+    <*> argument auto (metavar "bool"+      <> completeWith ["true", "false"]+      <> help "boolean just to test something"+    )++piLoadCsv :: ParserInfo CommandArgs+piLoadCsv = info (cmdLoadCsvArgs <**> helper)+  ( fullDesc+  <> progDesc "Load a csv file generated from wireshark"+  )++piLoadPcapOpts :: ParserInfo CommandArgs+-- <**> helper)+piLoadPcapOpts = info loadPcapArgs+  ( fullDesc+  <> progDesc "Load a pcap file via wireshark"+  <> footer "Example: load-pcap examples/client_2_filtered.pcapng"+  <> allPositional+  )+++-- myHandleParseResult :: ParserResult a -> m CMD.RetCode+-- myHandleParseResult (Success a) =++++-- |Load a .csv file+cmdLoadCsv :: (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] m)+    => FilePath   -- ^ csv file to load+    -> Sem m CMD.RetCode+cmdLoadCsv csvFilename  = do++    P.trace $ "Loading " ++ csvFilename+    frame <- liftIO $ loadRows csvFilename+    -- TODO restore+    -- loadedFile .= Just frame+    P.modify (\s -> s { _loadedFile = Just frame })+    Log.info $ "Number of rows " <> tshow  (frameLength frame)+    Log.debug "Frame loaded" >> return CMD.Continue+
+ src/MptcpAnalyzer/Commands/Map.hs view
@@ -0,0 +1,155 @@+{-+Module:  MptcpAnalyzer.Commands.Map+Description : Map tcp.stream ids from one pcap to another+Maintainer  : matt+Portability : Linux+++* Mapping tcp.stream ids from one pcap to another++-}+module MptcpAnalyzer.Commands.Map (+  mapTcpOpts+  , mapMptcpOpts+  -- , parserMapConnection+  , cmdMapTcpConnection+  , cmdMapMptcpConnection+)+where++import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Commands.List as CMD+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Map+import MptcpAnalyzer.Merge+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Completion (completePath, readFilename)+import MptcpAnalyzer.Utils.Text+import Net.Mptcp++import Options.Applicative+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import Polysemy.State as P+import Polysemy.Trace as P+import Prelude hiding (log)+-- import Colog.Polysemy (Log, log)+import Data.Either (lefts, rights)+import Data.Function (on)+import Data.List (sortBy, sortOn)+import Data.Text (intercalate)+import qualified Data.Text as TS+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import System.Console.ANSI+import System.Console.Haskeline+import Tshark.Main (defaultTsharkPrefs)+++mapTcpOpts :: ParserInfo CommandArgs+mapTcpOpts = info (+    (parserMapConnection False) <**> helper)+  ( progDesc "Attempts to map a TCP connection to another one"+  )++mapMptcpOpts :: ParserInfo CommandArgs+mapMptcpOpts = info (+    parserMapConnection True <**> helper)+  ( progDesc "Maps a MPTCP connection to another one"+  )++parserMapConnection :: Bool -> Parser CommandArgs+parserMapConnection forMptcp =+    ArgsMapTcpConnections <$> (+      CommandMapPcap <$>+      strArgument (+          metavar "PCAP1"+          <> completer completePath+          <> help "File to analyze"+      )+      <*> strArgument (+          metavar "PCAP2"+          <> completer completePath+          <> help "File to analyze"+      )+      -- readStreamId+      <*> argument auto (+          metavar "TCP_STREAM"+          <> help "stream id to analyzer"+      )+      <*> switch (+          long "verbose"+          <> help "Verbose or not"+      )+      <*> option auto (+          metavar "LIMIT"+        <> Options.Applicative.value 10++          <> help "Limit the number of comparisons to display"+      )+      )+      <*> option auto (+          metavar "MPTCP"+        -- internal is stronger than --belive, hides from all descriptions+        <> internal+        <> Options.Applicative.value forMptcp+        <> help ""+      )++printInRed :: String -> String+printInRed val = setSGRCode [SetColor Foreground Vivid Red] ++ val ++ setSGRCode [Reset]++-- TODO this could be made polymorphic using StreamConnection+cmdMapTcpConnection, cmdMapMptcpConnection :: (Members '[Log, P.State MyState, P.Trace, Cache, Embed IO] r )+  => CommandMapPcap -> Sem r RetCode+cmdMapTcpConnection (CommandMapPcap pcap1 pcap2 streamId verbose limit) = do+  Log.info "Mapping tcp connections"+  res <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcap1 (StreamId streamId)+  res2 <- loadPcapIntoFrame defaultTsharkPrefs pcap2+  case (res, res2) of+    (Right aframe, Right frame) -> do+      let streamsToCompare = (getTcpStreams frame)+      let consToCompare = map (buildTcpConnectionFromStreamId frame) (getTcpStreams frame)+      Log.info $ "Best match for " <> tshow (ffCon aframe) <> " is "+      Log.info $ "Comparing with stream " <> tshow streamsToCompare+      -- TODO sort results and print them+      let sortedScores = mapTcpConnection aframe frame+      -- TODO only display X first take 5+      P.trace $ TS.unpack $ intercalate "\n" $ map displayScore sortedScores+      -- display failures+      P.trace $ TS.unpack $ intercalate "\n" $ map displayFailure (lefts consToCompare)+      return CMD.Continue+      where+        displayScore (con, score) = "Score for connection " <> showConnectionText con+            <> ": " <> TS.pack (printInRed $ show score)+        displayFailure err = "Couldn't compute score for tcp.stream  " <> tshow err+    _ -> return $ CMD.Error "An error happened"++cmdMapMptcpConnection (CommandMapPcap pcap1 pcap2 streamId verbose limit) = do+  Log.info "Mapping mptcp connections"+  res <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap1 (StreamId streamId)+  res2 <- loadPcapIntoFrame defaultTsharkPrefs pcap2+  case (res, res2) of+    (Right aframe, Right frame) -> do+      let streamsToCompare = getMptcpStreams frame+      let consToCompare = map (buildTcpConnectionFromStreamId frame) (getTcpStreams frame)+      Log.info $ "Best match for " <> tshow (ffCon aframe) <> " is "+      Log.debug ("Comparing with stream " <> tshow streamsToCompare)+      -- let scores = map (evalScore (ffCon aframe)) (rights consToCompare)+      -- let sortedScores = (sortOn snd scores)+      let sortedScores = mapMptcpConnection aframe frame+      P.trace $ TS.unpack $ intercalate "\n" $ map displayScore sortedScores+      P.trace $ TS.unpack $ intercalate "\n" $ map displayFailure (lefts consToCompare)+      return CMD.Continue+      where+        evalScore con1 (FrameTcp con2 _) = (con2, similarityScore con1 con2)++        -- setSGRCode [SetColor Foreground Vivid Red] <>+        -- <> setSGRCode [Reset]+        displayScore (con, score) = "Score for connection " <> tshow (mpconStreamId con)+            <> ": " <> tshow score <> "\n" <> showConnectionText con <> "\n"+        displayFailure err = "Couldn't compute score for mptcp.stream " <> tshow err+    _ -> return $ CMD.Error "An error happened"
+ src/MptcpAnalyzer/Commands/Plot.hs view
@@ -0,0 +1,435 @@+{-|+Module: MptcpAnalyzer.Commands.Plot+Maintainer  : matt+License     : GPL-3+++-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+module MptcpAnalyzer.Commands.Plot (+  -- * Actual commands that plot+    cmdPlotMptcpAttribute+  , cmdPlotTcpAttribute++  -- * parsers+  , piPlotTcpMainParser+  , parserPlotTcpMain+  , parserPlotTcpLive+  , parserPlotMptcpLive+  , parserPlotMptcpMain+)+where++-- from mptcpanalyzer+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Plots.Types+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Completion (completePath, readFilename)+-- import MptcpAnalyzer.Commands.Definitions+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Commands.PlotOWD+import MptcpAnalyzer.Debug+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Utils.Text+import Net.IP+import Net.Mptcp+import Net.Tcp+import Tshark.Fields (TsharkFieldDesc(tfieldLabel), baseFields)+-- import Net.IPv4++-- hackage+import Frames+import Frames.CSV+import Options.Applicative+import Prelude hiding (filter, log, lookup, repeat)++-- import Graphics.Rendering.Chart.Backend.Diagrams (defaultEnv, runBackendR)+-- import Graphics.Rendering.Chart.Easy++import Data.Vinyl (ElField(..), Rec(..), rapply, rmapX, xrec)+import Data.Vinyl.Class.Method+import Data.Word (Word16, Word32, Word64, Word8)+import Graphics.Rendering.Chart.Backend.Cairo (toFile)+import Graphics.Rendering.Chart.Easy hiding (argument)++import Data.List (filter, intercalate)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Pipes as P+import qualified Pipes.Prelude as P+import Polysemy+import qualified Polysemy as P+import Polysemy.State as P+import Polysemy.Trace as P+-- import Colog.Polysemy (Log, log)+import System.Exit+import System.Process hiding (runCommand)+-- import Data.Time.LocalTime+-- import Data.Foldable (toList)+import qualified Data.Foldable as F+import qualified Data.Map as Map+import Data.Maybe (catMaybes, fromMaybe, isJust, maybeToList)+import qualified Data.Set as Set+import Data.String+import Data.Time+import Data.Vinyl.TypeLevel+import Debug.Trace+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import Frames.ShowCSV (showCSV)+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import System.Directory (renameFile)+import System.IO (Handle)+import Text.Read (readEither)++-- import Data.Time.Calendar+import Data.Time.LocalTime+import MptcpAnalyzer.Stream++mkDate :: Integer -> LocalTime+mkDate jday =+  LocalTime (ModifiedJulianDay jday) midnight++-- Plot MPTCP subflow attributes over time++-- | Parses options common to all plots like the title+parserPlotSettings :: Bool -> Parser PlotSettings+parserPlotSettings mptcpPlot = PlotSettings+    <$> optional (strOption+      ( long "out" <> short 'o'+      <> help "Save filename of the plot."+      <> metavar "OUT" ))+    <*> optional ( strOption+      ( long "title" <> short 't'+      <> help "Overrides the default plot title."+      <> metavar "TITLE" ))+    <*> switch ( long "display" <> help "Uses xdg-open to display plot")+    <*> option auto (+          metavar "MPTCP"+        -- internal is stronger than --belive, hides from all descriptions+        <> internal+        <> Options.Applicative.value mptcpPlot+        <> help ""+      )+++-- |+-- @param+-- TODO specialize ArgsPlots for TCP ?+piPlotTcpMainParser :: ParserInfo CommandArgs+piPlotTcpMainParser = info parserPlotTcpMain+  ( progDesc " TCP Plots"+  )+++--+parserLivePlotTcpSettings :: Parser LivePlotTcpSettings+parserLivePlotTcpSettings = LivePlotTcpSettings <$>+    parserConnection+    <*> optional (strOption+      ( long "fake" <> short 'f'+      <> help "Load data from a pcap. This is used only for testing."+      <> completer completePath+      <> metavar "PCAP" ))+    <*> optional (parserDestinationRole)+  <*> strArgument (+    metavar "interface" <> help "interface to monitor"+    -- TODO fetch list of interfaces in advance !+    <> completeWith ["eno1"]+    )++-- loadConnectionsFromFile+plotLiveFilter :: Parser ArgsPlots+plotLiveFilter = ArgsPlotLiveTcp <$> parserLivePlotTcpSettings+++-- |Helper to load an IP+readIP :: ReadM IP+-- encode or decode available, IP has+readIP = eitherReader $ \arg -> case decode $ T.pack arg of+    Just ip -> Right ip+    _otherwise -> Left $ "Could not decode ip " ++ arg++parserConnection :: Parser TcpConnection+parserConnection = TcpConnection <$>+  argument readIP (metavar "CLIENT_IP" <> help "Client IP (v4 or v6)")+  <*> argument readIP (metavar "SERVER_IP" <> help "Server IP (v4 or v6)")+  <*> argument auto (metavar "CLIENT_PORT" <> help "Client port")+  <*> argument auto (metavar "SERVER_PORT" <> help "Server port")+  -- Stream id wont be used anyway+  <*> pure (StreamId 0)+  -- <*> strArgument ( metavar "interface" <> help "interface to monitor")++parserPlotTcpLive :: Parser CommandArgs+parserPlotTcpLive  = ArgsPlotGeneric <$> parserPlotSettings False+    <*> (plotLiveFilter)++parserPlotMptcpLive :: Parser CommandArgs+parserPlotMptcpLive  = ArgsPlotGeneric <$> parserPlotSettings False+    <*> (ArgsPlotLiveMptcp <$> parserLivePlotTcpSettings)+++-- -> Bool -- ^ for mptcp yes or no+parserPlotTcpMain :: Parser CommandArgs+parserPlotTcpMain  = ArgsPlotGeneric <$> parserPlotSettings False+    <*> hsubparser (+      command "attr" (info (plotStreamParser validTcpAttributes False)+          (progDesc "toto"))+      <> command "owd" piPlotTcpOwd+      )+++parserPlotMptcpMain :: Parser CommandArgs+parserPlotMptcpMain  = ArgsPlotGeneric <$> parserPlotSettings True+    <*> hsubparser (+      command "attr" (info (plotStreamParser validTcpAttributes True)+          (progDesc "Plot MPTCP attribute (choose from ...)"))+      <> command "owd" (info (plotParserOwd True) (progDesc "Plot MPTCP owd"))+      )++-- piPlotTcpAttrParser :: ParserInfo ArgsPlots+-- piPlotTcpAttrParser = info (plotStreamParser validTcpAttributes False)+--   ( progDesc "Plot TCP attr"+--   )++-- |+-- @param+piPlotMptcpParser :: ParserInfo ArgsPlots+piPlotMptcpParser = info (+  plotStreamParser validMptcpAttributes True+  )+  ( progDesc "Plot MPTCP attr"+  )+++-- Superset of @validTcpAttributes@+validMptcpAttributes :: [String]+validMptcpAttributes = validTcpAttributes+-- |Options that are available for all parsers+-- plotParserGenericOptions+-- TODO generate from the list of fields, via TH?++validTcpAttributes :: [String]+validTcpAttributes = map T.unpack (Map.keys $ Map.mapMaybe tfieldLabel baseFields)+++validateField :: [String] -> ReadM String+validateField validFields = eitherReader $ \arg -> if elem arg validFields then+  Right arg+  else Left $ validationErrorMsg validFields arg++validationErrorMsg :: [String] -> String -> String+validationErrorMsg validFields entry = "validatedField: incorrect value `" ++ entry ++ "` choose from:\n -" ++ intercalate "\n - " validFields+++parserDestinationRole :: Parser ConnectionRole+parserDestinationRole = argument readConnectionRole (+          metavar "Destination"+        -- <> Options.Applicative.value RoleServer+        <> help "Only show in a specific direction"+        <> completeWith ["server", "client"]+      )++-- TODO pass the list of accepted attributes (so that it works for TCP/MPTCP)+plotStreamParser ::+       [String]+    -- ^ List of TCP attribute names+    -> Bool -- ^ for mptcp yes or no+    -> Parser ArgsPlots+plotStreamParser _validAttributes mptcpPlot = ArgsPlotTcpAttr <$>+      -- this ends up being not optional !+      -- argument (validateField _validAttributes) (+      --     metavar "FIELD"+      --     <> help ( "Field to plot (choose from " ++ (intercalate ", " _validAttributes) ++ ")")+      -- )+      strArgument (+          metavar "PCAP"+          <> help "File to analyze"+      )+      <*> argument auto (+          metavar "STREAM_ID"+          <> help "Stream Id (tcp.stream)"+      )+      -- TODO validate as presented in https://github.com/pcapriotti/optparse-applicative/issues/75+      <*> argument (validateField _validAttributes) (+          metavar "TCP_ATTR"+          <> help ("A TCP attr in the list: " <> (unlines validTcpAttributes))+          <> completeWith _validAttributes+      )+      -- TODO ? if nothing prints both directions+      <*> optional (parserDestinationRole)+      <**> helper++-- | A typeclass abstracting the functions we need+-- to be able to plot against an axis of type a+-- class Ord a => PlotValue a where+--     toValue  :: a -> Double+--     fromValue:: Double -> a+--     autoAxis :: AxisFn a++-- instance RealFloat Word32 where++-- deriving instance PlotValue Word32+instance PlotValue Word32 where+    -- => toDouble+    toValue  = fromIntegral+    -- => double -> value+    fromValue = truncate . toRational+        -- autoAxis = autoScaledAxis def+    -- autoScaledAxis def+    -- autoAxis = autoScaledIntAxis def+    autoAxis   = autoScaledIntAxis defaultIntAxis++instance PlotValue Word64 where+    -- => toDouble+    toValue  = fromIntegral+    -- => double -> value+    fromValue = truncate . toRational+        -- autoAxis = autoScaledAxis def+    -- autoScaledAxis def+    -- autoAxis = autoScaledIntAxis def+    autoAxis   = autoScaledIntAxis defaultIntAxis++-- called PlotTcpAttribute in mptcpanalyzer+-- todo pass --filterSyn Args fields+-- TODO filter according to destination+++-- | Plots the selected attribute+-- ![image description](pathtoimage.png)++cmdPlotTcpAttribute :: (+  Members [Log, P.State MyState, Cache, Embed IO] m+  )+  => String -- ^Tcp attribute see @validTcpAttributes@+  -- -> FilePath -- ^ temporary file to save plot to+  -> [ConnectionRole]+  -> FrameFiltered TcpConnection Packet+  -- we could return a EC r () instead+  -> Sem m (EC (Layout Double Double) ())+cmdPlotTcpAttribute field destinations aFrame = do++-- inCore converts into a producer+  -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)+  -- embed $ writeCSV "debug.csv" frame2+  -- TODO provide a nice label+  -- TODO generate for mptcp plot+  return $ do+    layout_title .= "TCP " ++ field+    mapM_ plotAttr destinations++  -- return Continue+  where+    -- filter by dest+    frame2 = addTcpDestinationsToAFrame aFrame+    -- plotAttr :: ( PlotValue y) => ConnectionRole -> EC (Layout Double y) ()+    plotAttr dest =+        plot (line ("TCP " ++ field ++ " (" ++ show dest ++ ")") [ [ (d,v) | (d,v) <- plotData ] ])+        -- plot (line ("TCP " ++ field ++ " (" ++ show dest ++ ")") [ my_data ])+        where+          -- frameDest = ffTcpFrame tcpFrame+          frameDest = frame2+          unidirectionalFrame = filterFrame (\x -> x ^. tcpDest == dest) (ffFrame frameDest)++          plotData :: [(Double, Double)]+          plotData = getData (unidirectionalFrame') field++          -- we add a fake mptcpDest column to satisfy+          unidirectionalFrame' = fmap (\x -> Col RoleServer :& x) unidirectionalFrame+          -- (timeData, seqData) = plotData+++-- it should be possible to get something more abstract+getData ::+            -- RecElem+            --   Rec TcpLen TcpLen rs rs (Data.Vinyl.TypeLevel.RIndex TcpLen rs),+            -- (Record HostCols) <: (Record rs)+            -- Foldable t, Functor t+            FrameRec (MptcpDest ': TcpDest ': HostCols) -> String -> [(Double, Double)]+getData frame attr =+  getAttr+  where+    -- timeData :: [Double]+    timeData = F.toList $ view relTime <$> frame++    getAttr = case attr of+      "tcpSeq" -> [ (t, v) | (t, v) <- zip timeData (getTcpData tcpSeq) ]+      -- "tcpLen" -> fromIntegral. view tcpLen+      -- "rwnd" -> fromIntegral. view rwnd+      -- "tcpAck" -> fromIntegral. view tcpAck+      -- "tsval" -> tsval+      "mptcpDsn" -> getMptcpData frame mptcpDsn+      "mptcpDack" -> getMptcpData frame mptcpDack++      _          -> error "unsupported attr"++    -- getTcpData  t (Record (TcpDest ': HostCols) )  ::+    -- getTcpData  frame' getter = F.toList $ (fromIntegral . view getter) <$> frame'++    getTcpData getter = F.toList ((fromIntegral . view getter) <$> frame)++getMptcpData :: _+getMptcpData frame getter =+  [ (t, v) | (t, v) <- zip timeData values ]+  -- (timeData, view relTime <$> justFrame)+  where+    timeData = F.toList $ view relTime <$> justFrame+    values = fmap fromIntegral $ catMaybes $ F.toList $ (view getter) <$> justFrame+    -- filter on the field+    justFrame = filterFrame (\x -> isJust $ x ^. getter) frame+++-- | Plot an attribute selected from ''+-- @TODO support more attributes+cmdPlotMptcpAttribute :: (+  Members [+    Log, P.State MyState, P.Trace, Cache, Embed IO+  ] m) => String -- ^ mptcp attr+    -> FilePath -- ^ temporary file to save plot to+    -> [ConnectionRole]+    -> FrameFiltered MptcpConnection Packet+    -> Sem m RetCode+cmdPlotMptcpAttribute field tempPath destinations aFrame = do++-- inCore converts into a producer+  Log.debug $ "show con " <> tshow (ffCon aFrame)+  P.trace $ T.unpack $ showConnectionText (ffCon aFrame)+  P.trace $ "number of packets" ++ show (frameLength (ffFrame aFrame))+  -- TODO remove+  embed $ writeCSV "debug.csv" (ffFrame aFrame)+  embed $ writeCSV "dest.csv" frameDest+  embed $ toFile def tempPath $ do+      layout_title .= "MPTCP " ++ field+      -- TODO generate for mptcp plot+      -- for each subflow, plot the MptcpDest+      mapM_ plotAttr ( [ (dest, con) | dest <- destinations , con <- Set.toList $ _mpconSubflows $ ffCon aFrame ])+      -- mapM_ plotAttr destinations++  return Continue+  where+    -- add dest to the whole frame+    frameDest = addMptcpDest (ffFrame aFrame) (ffCon aFrame)+    plotAttr (dest, sf) =+      -- plot (line lineLabel [ [ (d,v) | (d,v) <- zip timeData seqData ] ])+      plot (line lineLabel [ frameData ])+      where+          -- frameData :: ([Double], [+          -- strip down+          frameData = getData unidirectionalFrame field+          -- show sf+          lineLabel = "subflow " ++ show (conTcpStreamId (sfConn sf))  ++ " seq (" ++ show dest ++ ")"+          -- frameDest = frame2+          unidirectionalFrame = filterFrame (\x -> x ^. mptcpDest == dest+                    && x ^. tcpStream == conTcpStreamId (sfConn sf) ) frameDest++          -- seqData :: [Double]+          -- seqData = map fromIntegral (F.toList $ view tcpSeq <$> unidirectionalFrame)+          -- timeData = traceShow ("timedata" ++ show (frameLength unidirectionalFrame)) F.toList $ view relTime <$> unidirectionalFrame++
+ src/MptcpAnalyzer/Commands/PlotOWD.hs view
@@ -0,0 +1,327 @@+{-+Module      : MptcpAnalyzer.Commands.PlotOwd+Description : Plot One way delays+Maintainer  : matt+-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module MptcpAnalyzer.Commands.PlotOWD (+  cmdPlotTcpOwd+  , cmdPlotMptcpOwd+  , plotParserOwd+  , piPlotTcpOwd+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Debug+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Merge+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Plots.Types+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+-- for retypeColumn+-- import MptcpAnalyzer.Frames.Utils+-- for fields+import Net.Mptcp+import Net.Tcp++import Frames+import qualified Frames as F+import Frames.CSV+import Options.Applicative+import Polysemy+import qualified Polysemy.Trace as P+import Prelude hiding (filter, log, lookup, repeat)++-- import Graphics.Rendering.Chart.Backend.Diagrams (defaultEnv, runBackendR)+-- import Graphics.Rendering.Chart.Easy++import Data.Word (Word16, Word32, Word64, Word8)+import Graphics.Rendering.Chart.Backend.Cairo+import Graphics.Rendering.Chart.Easy hiding (argument)++import Data.Vinyl.TypeLevel as V++import Data.Text (Text)+import qualified Data.Text as T+import qualified Pipes as P hiding (embed)+import qualified Pipes.Prelude as P+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import Polysemy.State as P+import System.Exit+import System.Process hiding (runCommand)+-- import Data.Time.LocalTime+import Data.Foldable (toList)+import Data.Maybe (catMaybes, fromMaybe)+import qualified Data.Set as Set+import Debug.Trace+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import Frames.ShowCSV (showCSV)+import GHC.TypeLits (Symbol)+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import System.Directory (renameFile)+import System.IO (Handle)+import Tshark.Main (defaultTsharkPrefs)++-- data PlotTypes = PlotTcpAttribute {+--     pltAttrField :: Text+--     -- syndrop => drop syn packets+--     -- Drops first 3 packets of the dataframe assuming they are syn+--   }++-- Plot MPTCP subflow attributes over time++-- piPlotParserTcpAttr :: Parser PlotTypes+-- piPlotParserTcpAttr = PlotTcpAttribute <$> argument str+--       ( help "Choose an mptcp attribute to plot"+--       <> metavar "FIELD" )++-- |+-- @param+piPlotTcpOwd ::  ParserInfo ArgsPlots+piPlotTcpOwd = info (plotParserOwd False) (progDesc "Plot TCP owd")++++-- TODO pass the list of accepted attributes (so that it works for TCP/MPTCP)+plotParserOwd ::+    -- [String]+    Bool -- ^ for mptcp yes or no+    ->+    Parser ArgsPlots+plotParserOwd _mptcpPlot = ArgsPlotOwdTcp <$>+      parserPcapMapping False+      -- this ends up being not optional !+      -- strArgument (+      --     metavar "PCAP1"+      --     <> help "File to analyze"+      -- )+      -- <*> strArgument (+      --     metavar "PCAP2"+      --     <> help "File to analyze"+      -- )+      -- -- auto readStreamId+      -- <*> argument auto (+      --     metavar "STREAM_ID1"+      --     <> help "Stream Id (tcp.stream)"+      -- )+      -- <*> argument auto (+      --     metavar "STREAM_ID2"+      --     <> help "Stream Id (tcp.stream)"+      -- )+      -- TODO validate as presented in https://github.com/pcapriotti/optparse-applicative/issues/75+      --validate :: (a -> Either String a) -> ReadM a -> ReadM a+      -- TODO ? if nothing prints both directions+      <*> optional (argument readConnectionRole (+          metavar "Destination"+        -- <> Options.Applicative.value RoleServer+        <> help ""+      ))+      -- <**> help+      -- <*> option auto (+      --     metavar "MPTCP"+      --   -- internal is stronger than --belive, hides from all descriptions+      --   <> internal+      --   <> Options.Applicative.value mptcpPlot+      --   <> help ""+      -- )++-- called PlotTcpAttribute in mptcpanalyzer+-- todo pass --filterSyn Args fields+-- TODO filter according to destination++-- destinations is an array of destination+-- cmdPlotTcpAttribute :: Members [Log String,  P.State MyState, Cache, Embed IO] m =>+--           FilePath -- ^ temporary file to save plot to+--           -> Handle+--           -> [ConnectionRole]+--           -> FrameFiltered Packet+--           -> Sem m RetCode+-- cmdPlotTcpAttribute tempPath _ destinations aFrame = do++-- -- inCore converts into a producer+--   -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)+--   -- embed $ writeCSV "debug.csv" frame2+--   embed $ toFile def tempPath $ do+--       layout_title .= "TCP Sequence number"+--       -- TODO generate for mptcp plot+--       flip mapM_ destinations plotAttr++--   return Continue+--   where+--     -- filter by dest+--     frame2 = addTcpDestinationsToAFrame aFrame+--     plotAttr dest =+--         plot (line ("TCP seq (" ++ show dest ++ ")") [ [ (d,v) | (d,v) <- zip timeData seqData ] ])+--         where+--           -- frameDest = ffTcpFrame tcpFrame+--           frameDest = frame2+--           -- frameDest = frame2+--           unidirectionalFrame = filterFrame (\x -> x ^. tcpDest == dest) (ffFrame frameDest)++--           seqData :: [Double]+--           seqData = map fromIntegral (toList $ view tcpSeq <$> unidirectionalFrame)+--           timeData = toList $ view relTime <$> unidirectionalFrame++-- AbsTime2+-- type AbsTime2 = "absTime2" :-> Text  -- :: (Symbol, *)++-- absTime2 is problematic+-- declareColumn "absTime2" ''Text+-- declareColumn "absTimeSnd" ''Double+-- type AbsTime2 = "absTime2" :-> Text  -- :: (Symbol, *)+-- expects (Symbol, Symbol, Type)+-- type AbsTimeRenameTest =   ("absTime" :: Symbol, "absTime2", Text)++-- type RetypeMatt = [+--   ("absTime", "absTime2", Text)+--   ]++cmdPlotTcpOwd :: (Members [Log, P.Trace, P.State MyState, Cache, Embed IO] m)+  => FilePath -- ^ temporary file to save plot to+  -> Handle+  -> [ConnectionRole]+  -- -> TcpConnection+  -> (PcapMapping Tcp)+  -- -> MergedFrame+  -- -> FrameFiltered Packet+  -- -> FrameFiltered (Record HostColsPrefixed)+  -> Sem m RetCode+cmdPlotTcpOwd tempPath _ destinations (PcapMapping pcap1 streamId1 pcap2 streamId2) = do+  Log.info "plotting TCP OWDs "+  -- look at https://hackage.haskell.org/package/vinyl-0.13.0/docs/Data-Vinyl-Functor.html#t::.+  -- could use showRow as well+  -- P.embed $ dumpRec $ head justRecs+  -- P.trace $ "There are " ++ show (length justRecs) ++ " valid merged rows (out of " ++ show (length mergedRes) ++ " merged rows)"+  -- P.trace $ (concat . showFields) (head justRecs)+  -- P.embed $ putStrLn $ "retyped column" ++ (concat . showFields) (newCol)+  Log.info $ "plotting owd for tcp.stream " <> tshow streamId1 <> " and " <> tshow streamId2+  eframe1 <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcap1 streamId1+  eframe2 <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcap2 streamId2++  res <- case (eframe1, eframe2 ) of+    (Left err, _) -> return $ CMD.Error err+    (_, Left err) -> return $ CMD.Error err+    (Right (FrameTcp con frame1), Right aframe2) -> do+        -- TODO addTcpDest -> convert then+        let+          dest = genTcpDestFrame frame1 con++          convertCols' :: Record '[TcpDest] -> Record '[SenderDest]+          convertCols' = F.withNames . F.stripNames+          sendFrame = fmap convertCols' dest++        mergedRes <- mergeTcpConnectionsFromKnownStreams (FrameTcp con (F.zipFrames sendFrame frame1)) aframe2+        -- let mbRecs = map recMaybe mergedRes+        -- let justRecs = catMaybes mbRecs+        let sndRcvFrame = convertToSenderReceiver mergedRes++        embed $ toFile def tempPath $ do+            layout_title .= "TCP One-way delays"+            -- TODO generate for mptcp plot+            -- for each subflow, plot the MptcpDest+            mapM_ (plotAttr sndRcvFrame)  [ x | x <- destinations]+++        -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)+        -- embed $ writeDSV defaultParserOptions "tcp-owd-debug.csv" (toFrame justRecs)+        embed $ writeDSV defaultParserOptions "tcp-owd-converted.csv" sndRcvFrame+        -- P.embed $ putStrLn $ "OWDs:" ++ show owd+        -- so for now we assume an innerJoin (but fix it later)+        return Continue+        where+          -- mbRecs = map recMaybe mergedRes+          -- justRecs = catMaybes mbRecs+          dumpRec x = print x+          -- add dest to the whole frame+          -- frameDest = addMptcpDest (ffFrame aFrame) (ffCon aFrame)+          plotAttr sndRcvFrame dest =+            plot (line lineLabel [ [ (d,v) | (d,v) <- zip timeData owd ] ])++              where+                lineLabel = "TCP seq " ++ showConnection con ++ " (towards " ++ showConnectionRole dest ++ ")"+                unidirectionalFrame = filterFrame (\x -> x ^. senderDest == dest) sndRcvFrame++                timeData = traceShow ("timedata length=" ++ show (frameLength unidirectionalFrame)) toList $ view sndAbsTime <$> unidirectionalFrame++                getOwd x = (x ^. rcvAbsTime) - (x ^. sndAbsTime)++                owd :: [Double]+                owd = let res = map getOwd (toList unidirectionalFrame) in traceShow res res+  return res+++++cmdPlotMptcpOwd :: (+  Members [Log, P.Trace, P.State MyState, Cache, Embed IO] m)+  => FilePath -- ^ temporary file to save plot to+  -> Handle+  -> [ConnectionRole]+  -> TcpConnection+  -> MergedFrame+  -> Sem m RetCode+cmdPlotMptcpOwd tempPath _ destinations con mergedRes = do+  Log.info "plotting MPTCP OWDs "+  -- look at https://hackage.haskell.org/package/vinyl-0.13.0/docs/Data-Vinyl-Functor.html#t::.+  -- could use showRow as well+  -- P.embed $ dumpRec $ head justRecs+  -- P.trace $ "There are " ++ show (length justRecs) ++ " valid merged rows (out of " ++ show (length mergedRes) ++ " merged rows)"+  -- P.trace $ (concat . showFields) (head justRecs)+  -- P.embed $ putStrLn $ "retyped column" ++ (concat . showFields) (newCol)+  embed $ toFile def tempPath $ do+      layout_title .= "MPTCP One-way delays"+      -- TODO generate for mptcp plot+      -- for each subflow, plot the MptcpDest+      mapM_ plotAttr  [ x | x <- destinations]+++  -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)+  -- embed $ writeDSV defaultParserOptions "mptcp-owd-debug.csv" (toFrame justRecs)+  embed $ writeDSV defaultParserOptions "mptcp-owd-converted.csv" sndRcvFrame+  -- P.embed $ putStrLn $ "OWDs:" ++ show owd+  -- so for now we assume an innerJoin (but fix it later)++  return Continue+  where+    -- mbRecs = map recMaybe mergedRes+    -- justRecs = catMaybes mbRecs+    sndRcvFrame = convertToSenderReceiver mergedRes+    dumpRec x = print x+    -- add dest to the whole frame+    -- frameDest = addMptcpDest (ffFrame aFrame) (ffCon aFrame)+    plotAttr dest =+      plot (line lineLabel [ [ (d,v) | (d,v) <- zip timeData owd ] ])++        where+          lineLabel = "Subflow DSNs " ++ showConnection con ++ " (towards " ++ showConnectionRole dest ++ ")"+          unidirectionalFrame = filterFrame (\x -> x ^. senderDest == dest) sndRcvFrame++          timeData = traceShow ("timedata length=" ++ show (frameLength unidirectionalFrame)) toList $ view sndAbsTime <$> unidirectionalFrame++          getOwd x = (x ^. rcvAbsTime) - (x ^. sndAbsTime)++          owd :: [Double]+          owd = let res = map getOwd (toList unidirectionalFrame) in traceShow res res++
+ src/MptcpAnalyzer/Commands/Reinjections.hs view
@@ -0,0 +1,337 @@+{-|++Module      : MptcpAnalyzer.Commands.Reinjections+Description : Command to analyze reinjections+Maintainer  : matt+++-}+{-# LANGUAGE PackageImports #-}+module MptcpAnalyzer.Commands.Reinjections (++  piListReinjections+  , piQualifyReinjections+  , qualifyReinjections+  , cmdListReinjections+  , cmdQualifyReinjections+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Commands.List as CMD+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Merge+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import Net.Mptcp++import Control.Lens ((^.))+import Control.Lens hiding (argument)+import Data.Either (lefts, rights)+import Data.Foldable (toList)+import qualified Data.Foldable as F+import Data.Function (on)+import Data.List (intercalate, intersperse, sortBy, sortOn)+import Data.Maybe+import Frames+import Frames.CSV+import Frames.Rec+import Options.Applicative+import qualified Pipes+import qualified Pipes.Prelude as Pipes+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.State as P+import Polysemy.Trace as P+import Prelude hiding (log)++import Control.Monad+import qualified Debug.Trace as D+import Tshark.Main (defaultTsharkPrefs)++piListReinjections :: ParserInfo CommandArgs+piListReinjections = info (+    parserListReinjections+    <**> helper)+  ( progDesc "List MPTCP reinjections"+  )+  where+    -- parserListReinjections :: Parser CommandArgs+    parserListReinjections =+          ArgsListReinjections <$>+          -- strArgument (+          --     metavar "PCAP1"+          --     <> help "File to analyze"+          -- )+          -- <*>+          argument readStreamId (+              metavar "TCP_STREAM"+              <> help "stream id to analyze"+          )++piQualifyReinjections :: ParserInfo CommandArgs+piQualifyReinjections = info (+    parserQualifyReinjections <**> helper)+  ( progDesc "Qualifies MPTCP reinjections"+  <> footer "analyze examples/client_2_redundant.pcapng 0 examples/server_2_redundant.pcapng 0"+  )+++parserQualifyReinjections :: Parser CommandArgs+parserQualifyReinjections =+      ArgsQualifyReinjections+      <$> parserPcapMapping False+      <*> switch (+          long "verbose"+          <> help "Verbose or not"+      )++cmdListReinjections :: (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)+    => StreamId Mptcp+    -> Sem r RetCode+cmdListReinjections streamId = do+  state <- P.get+  let loadedPcap = view loadedFile state+  case loadedPcap of+    Nothing -> do+      trace "please load a pcap first"+      return CMD.Continue+    Just (frame :: FrameRec HostCols) -> do+      let+        reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. reinjectionOf) frame+      -- log $ "Number of rows " ++ show (frameLength frame)+        outputs = fmap showReinjections reinjectedPacketsFrame+      -- P.embed $ putStrLn $ "Number of MPTCP connections " ++ show (length mptcpStreams)+      -- P.embed $ putStrLn $ show mptcpStreams+      P.trace $ intercalate "\n" (toList outputs)+      return CMD.Continue+      where+        -- packetid=757 (tcp.stream 1) is a reinjection of 1 packet(s):+        -- - packet 256 (tcp.stream 7)+        showReinjections row = "packetid=" ++ show (row ^. packetId) ++ " (tcp.stream " ++ show (row ^. tcpStream) ++ ")\n"+            -- TODO map over the list+            ++ intercalate "\n" ( map showReinjection (fromJust $ row ^. reinjectionOf))++        showReinjection reinjection = case toList $ filterFrame (\x -> x ^. packetId == reinjection) (frame) of+          [] -> error "did not find original packet"+          rows -> "- Reinjection of " ++ show reinjection ++ "(tcp.stream " ++ show ( (head rows)  ^. tcpStream) ++ ")"++-- Analyzes row of reinject packets+-- Compares arrival time of the first send of a segment with the+analyzeReinjection :: FrameRec SenderReceiverCols -> Record SenderReceiverCols -> Double+analyzeReinjection mergedFrame row =+  let+    -- a list of packetIds+    reinjectOf = fromJust (rgetField @SndReinjectionOf row)+    initialPktId = D.traceShowId $ head reinjectOf++    -- it is a frame++    originalPkt :: Record SenderReceiverCols+    originalPkt = let+          originalFrame = filterFrame (\x -> x ^. sndPacketId == initialPktId) mergedFrame+      in case frameLength originalFrame of+      0 -> error "empty frame"+      _ -> frameRow originalFrame 0++    origArrival, reinjArrival :: Double+    origArrival = rgetField @RcvRelTime originalPkt+    reinjArrival = rgetField @RcvRelTime originalPkt+    reinjPktId = row ^. sndPacketId++    delta = reinjArrival - origArrival+  in+    delta+++{- Tries to distinguish between useful and useless reinjections+  Also tries to evalute the usefulness by providing a delta showing how much time+  the reinjection made the connection win or lose+-}+cmdQualifyReinjections ::+  Members '[+    Log+    , P.State MyState+    , Cache+    , P.Trace+    , Embed IO+    ] r+  => PcapMapping Mptcp+  -> [ConnectionRole]+  -> Bool+  -> Sem r RetCode+cmdQualifyReinjections (PcapMapping pcap1 streamId1 pcap2 streamId2) destinations verbose = do+  eframe1 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap1 streamId1+  eframe2 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap2 streamId2+  res <- case (eframe1, eframe2 ) of+    (Right aframe1, Right aframe2) -> do++          mergedRes <- mergeMptcpConnectionsFromKnownStreams aframe1 aframe2+          let+            -- mergedRes = mergeMptcpConnectionsFromKnownStreams' aframe1 aframe2+            reinjectedPacketsHost1 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe1)+            reinjectedPacketsHost2 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe2)++            -- mbRecs = map recMaybe mergedRes+            -- packets that could be mapped in both pcaps+            -- justRecs = catMaybes mbRecs+            myFrame = convertToSenderReceiver mergedRes++            reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. sndReinjectionOf) myFrame++            -- loop over these reinjectpackets+            -- assume both were mapped++          -- Log.info $ "Result of the analysis; reinjections:"+            -- <> tshow (showReinjects justRecs)+          -- Log.debug $ "reinjectionsOf in host1 frame " <> tshow $ showFrame myFrame+          -- Log.debug $ "showing merged res" <> tshow (showMergedRes $ take 3 mergedRes)+          -- P.embed $ writeMergedPcap ("mergedRes-"  ++ ".csv") mergedRes+          trace $ "Size after conversion to sender/receiver " ++ show (frameLength myFrame)+                  ++ "( " ++ show (length mergedRes) ++ ")"+          -- trace $ "Number of reinjected packets: " ++ show (frameLength reinjectedPacketsFrame)++          -- trace $ "Merged mptcp connection\nFrame size: " ++ show (frameLength reinjectedPacketsFrame)+                  -- ++ "\n" ++ showFrame "," reinjectedPacketsFrame+          forM_ destinations $ \x -> do+            qualifyReinjections myFrame (assignRoles aframe1 aframe2) x++          -- qualifyReinjections tempPath handle (getDests dest) (ffCon aframe1) mergedRes+          return CMD.Continue+    (Left err, _) -> return $ CMD.Error err+    (_, Left err) -> return $ CMD.Error err+++  return CMD.Continue+    -- mergedPcap+    -- reinjectedPackets = filterFrame (sndReinjectionOf) (toFrame justRecs)++-- buildTcpConnectionFromSndRecord :: (+--   SndIpSource ∈ rs, SndIpDest ∈ rs, SndTcpSrcPort ∈ rs, SndTcpDestPort ∈ rs, SndTcpStream ∈ rs+--     -- rs ⊆ HostCols+--   )+--   => Record rs -> TcpConnection+-- buildTcpConnectionFromRecord r =+--   TcpConnection {+--     conTcpClientIp = r ^. sndIpSource+--     , conTcpServerIp = r ^. sndIpDest+--     , conTcpClientPort = r ^. sndTcpSrcPort+--     , conTcpServerPort = r ^. sndTcpDestPort+--     , conTcpStreamId = r ^. sndTcpStream+--   }+++-- buildConnectionFromSndPacket :: Record SenderReceiverCols -> TcpConnection+-- buildConnectionFromSndPacket row ->+++-- | Returns (Client,Server)+-- kinbda hackish+assignRoles :: FrameFiltered MptcpConnection Packet -> FrameFiltered MptcpConnection Packet+  -> (FrameFiltered MptcpConnection Packet , FrameFiltered MptcpConnection Packet)+assignRoles aframe1 aframe2 =+  if delta > 0 then+    (aframe1, aframe2)+  else+    (aframe2, aframe1)+  where+    -- assume non empty+    firstRow1 = frameRow (ffFrame aframe1) 0+    firstRow2 = frameRow (ffFrame aframe2) 0++    delta :: Double+    delta = (firstRow2 ^. absTime) - (firstRow1 ^. absTime)++    -- selectDest :: ConnectionRole -> FrameRec MergedHostCols+    -- selectDest dest = (filterFrame (\x -> x ^. senderDest == dest) jframe)+++-- TODO there should be a classification on a per mptcp basis+-- Here we should be able to tell who is the sender+qualifyReinjections :: Members '[+    Log, P.State MyState+    , Cache+    , P.Trace+    , Embed IO+    ] r+    => FrameRec SenderReceiverCols+    -- (Client, server) pcaps+    -> (FrameFiltered MptcpConnection Packet,FrameFiltered MptcpConnection Packet)+    -> ConnectionRole+    -> Sem r ()+qualifyReinjections frame (aframeH1, aframeH2) dest = do+    let+      -- "dest"frame+      dstFrame = filterFrame (\x -> x ^. senderDest == dest) frame+      -- mergedRes = mergeMptcpConnectionsFromKnownStreams' aframe1 aframe2+      -- reinjectedPacketsHost1 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe1)+      -- reinjectedPacketsHost2 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe2)+      reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. sndReinjectionOf) dstFrame+      reinjects = fmap (analyzeReinjection frame) reinjectedPacketsFrame++    trace $ "Qualify reinjections for dests " ++ show dest+    P.embed $ writeDSV defaultParserOptions ("sndrcv-merged-" ++ show dest  ++ ".csv") dstFrame+    trace $ "Number of reinjected packets: " ++ show (frameLength reinjectedPacketsFrame)+    -- trace $ "Result of the analysis; reinjections:" ++ showReinjects reinjects+    forM_ reinjectedPacketsFrame $ \row -> do+      let+        reinjectOf = fromJust (rgetField @SndReinjectionOf row)+        hostType = rgetField @SenderHost row+        senderDestVal = rgetField @SenderDest row++        -- originalFrame = if senderDest == RoleClient then (ffFrame aframeH2) else (ffFrame aframeH1)+        originalFrame = frame++        -- should be only one+        originalPackets = filterFrame (\x -> x ^. sndPacketId == initialPktId) originalFrame++        -- ((frameRow originalPacket 0) ^. senderHost)+        hostBool = if frameLength originalPackets > 0 then show hostType else "unknown"++        -- TODO we want to find+        -- buildTcpConnectionFromSndRecord++        initialPktId = D.traceShowId $ head reinjectOf+        -- initialPktId = D.traceShowId $ head reinjectOf+      -- of packet id " ++ show initialPktId+      -- from host" ++ show hostType+      trace $ show (row ^. sndPacketId) ++ " is a reinjection of packet id " ++ show initialPktId+      trace $ "number of original packets " ++ show (frameLength originalPackets) ++ " Host " ++ show senderDestVal+      trace $ describeReinjection row originalPackets+      -- TODO check if pktId is available++    where+        showReinjects frame2 =+          -- unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)+          intercalate "," rows+          where+            rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) frame2)++        describeReinjection reinjectedPacket originalPackets = case frameLength originalPackets of+          0 -> "No original packets found FISHY ?!"+          _otherwise -> let+                originalPacket = frameRow originalPackets 0+                reinjArrivalTime = reinjectedPacket ^. rcvAbsTime+                originalArrivalTime = originalPacket ^. rcvAbsTime+                reinj_delta = reinjArrivalTime - originalArrivalTime++            in+            if reinj_delta < 0 then+                "Efficient reinjection: latency gain: " ++ show reinj_delta++            else+              "Redundant reinjection" ++ show reinj_delta+              --++            --     # print("GOT A failed reinjection")+            --     df_all.loc[df_all[_sender("packetid")] == reinjection.packetid, "redundant"] = True+            --     #TODO set reinj_delta for reinjection.packetid+            -- else:+            --     # print("GOT a successful reinjection")+            --     pass+
+ src/MptcpAnalyzer/Debug.hs view
@@ -0,0 +1,53 @@+{-|+Module      : MptcpAnalyzer.Merge+Description : Utilities to help debug+Maintainer  : matt+License     : GPL-3+-}+module MptcpAnalyzer.Debug+where++import Data.Proxy+import Data.Vinyl+import Frames+import Frames.CSV+-- import Data.Text+import Data.List (intercalate)++{-+check:+  - showFrame+  - printFrame+from Frames.Exploration too+-}++-- pipeToCSV+-- see https://github.com/acowley/Frames/issues/130+showRow :: (RecMapMethod Show ElField a, RecordToList a)+        => (Record a) -> String+showRow row = intercalate "\t" $ showFields row++showHeader :: forall a . (ColumnHeaders a) => Frame (Record a) -> String+showHeader frame = intercalate "\t" $ columnHeaders (Proxy :: Proxy (Record a))++viewFrame :: (RecMapMethod Show ElField a, RecordToList a, ColumnHeaders a)+          => Frame (Record a) -> IO ()+viewFrame frame = do+  putStrLn $ showHeader frame+  mapM_ (putStrLn . showRow) frame++-- writeMergedPcap :: FilePath -> MergedPcap -> IO ()+-- writeMergedPcap outPath mergedPcap = do+--   -- showReinjects frame =+--     -- unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)+--     writeFile outPath content+--     where+--       content = intercalate "," rows+--       rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) mergedPcap)++++++--+-- embed $ writeCSV "debug.csv" (ffFrame aFrame)
+ src/MptcpAnalyzer/Frame.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-|+Description :+Maintainer  : matt+Stability   : testing+Portability : Linux+-}+module MptcpAnalyzer.Frame ()+where++import MptcpAnalyzer.Types+-- import Tshark.Main (defaultParserOptions)+import MptcpAnalyzer.Pcap (defaultParserOptions)++import Data.ByteString as BS+import Data.ByteString.Lazy as LBS+import Data.ByteString.Lazy.UTF8 as BLU+import Data.Serialize+import Data.Text as T+import Data.Text.Encoding as TSE+import Data.Vinyl hiding (rget)+import Frames+import Frames.CSV hiding (consumeTextLines)+import Frames.ShowCSV+import Pipes ((>->))+import qualified Pipes as P+import qualified Pipes.Parse as P+import qualified Pipes.Prelude as P+import qualified Pipes.Safe as P+import qualified Pipes.Safe.Prelude as Safe+import System.IO (Handle, IOMode(ReadMode, WriteMode))+-- import Data.Proxy+import qualified Data.Vinyl as V+import qualified Data.Vinyl.Class.Method as V+import System.IO.Unsafe (unsafePerformIO)+++-- convertToBs :: Frame (Record a) -> Put+-- convertToBs f = do+--       bs <- P.runSafeT . P.runEffect $ produceDSV defaultParserOptions f >-> P.map BLU.fromString+--       return bs++newtype Test a = FrameRec a++-- TODO here we want to put a bytestring+instance (ColumnHeaders rs, V.RecMapMethod Show ElField rs, V.RecordToList rs) => Serialize (Frame (Record rs)) where+  -- putByteString+  put f = do+      -- (csvDelimiter defaultTsharkPrefs)+      let bs = BLU.fromString $ showFrame "|" f+      -- let bs = unsafePerformIO $ do+      --         writeDSV defaultParserOptions tmpFile f+      --         BS.readFile tmpFile+      -- renvoie unit IO ()+      putByteString $ LBS.toStrict bs+      -- where+      --   tmpFile = "tmp.csv"+  -- put f = undefined+  get = undefined++-- consumeTextLines :: P.MonadSafe m => FilePath -> P.Consumer BS.ByteString m r+-- consumeTextLines fp = Safe.withFile fp WriteMode $ \h ->+--   let loop = P.await >>= P.liftIO . BS.hPut h >> loop+--   in loop
+ src/MptcpAnalyzer/Loader.hs view
@@ -0,0 +1,136 @@+{-|+Module      : MptcpAnalyzer.Loader+Description : Load pcap/csv into a @Frame@+Maintainer  : matt+License     : GPL-3+-}+module MptcpAnalyzer.Loader (+    loadPcapIntoFrame+  , loadPcapIntoFrameNoCache+  , buildAFrameFromStreamIdTcp+  , buildAFrameFromStreamIdMptcp+  )+where+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Frame+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Tshark.Main++import Control.Monad.Trans (liftIO)+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import Frames+import Frames.CSV+import qualified Frames.InCore+import Net.Mptcp+import Net.Tcp+import Polysemy (Embed, Members, Sem)+import Polysemy.State as P+import Prelude hiding (log)+import System.Exit (ExitCode(..))++import qualified Data.Vinyl as V+import qualified Data.Vinyl.Class.Method as V+import GHC.IO.Handle (hClose)+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log++loadPcapIntoFrameNoCache :: (+    Frames.InCore.RecVec a+    , Frames.CSV.ReadRec a+    , ColumnHeaders a+   )+    => TsharkParams+    -> FilePath+    -> IO (Either String (FrameRec a))+loadPcapIntoFrameNoCache params path = do+  res <- liftIO $ withTempFileEx opts "/tmp" "mptcp.csv" $ \tmpPath handle -> do+    res <- exportToCsv params path handle+    case res of+      (ExitSuccess, _ ) -> do+        -- we have to close the handle else loadRows can't access the file !+        hClose handle+        loaded <- loadRows tmpPath+        return $ Right loaded+      (exitCode, stdErr) -> return $ Left $ "Error happened " ++ show exitCode ++ "\n" ++ show stdErr+  return res+  where+    opts :: TempFileOptions+    opts = TempFileOptions False++-- TODO return an Either or Maybe ?+-- return an either instead+loadPcapIntoFrame ::+    (Frames.InCore.RecVec a+    , Frames.CSV.ReadRec a+    , ColumnHeaders a+    , V.RecMapMethod Show ElField a, V.RecordToList a+    , Members [Log, Cache, Embed IO ] m)+    => TsharkParams+    -> FilePath+    -> Sem m (Either String (FrameRec a))+loadPcapIntoFrame params path = do+    Log.info $ "Start loading pcap " <> tshow path+    x <- getCache cacheId+    case x of+      Right frame -> do+          Log.debug $ tshow cacheId <> " in cache"+          return $ Right frame+      Left err -> do+          Log.debug $ "cache miss: " <> tshow  err+          Log.debug "Calling tshark"+          (tempPath , exitCode, stdErr) <- liftIO $ do+            withTempFileEx opts "/tmp" "mptcp.csv" $ \tmpPath handle -> do+                (exitCode, herr) <- exportToCsv params path handle+                hClose handle+                return (tmpPath, exitCode, herr)++          if exitCode == ExitSuccess+              then do+                Log.debug $ "exported to file " <> tshow tempPath+                frame <- liftIO $ loadRows tempPath+                Log.debug $ "Number of rows after loading " <> tshow (frameLength frame)+                cacheRes <- putCache cacheId frame+                -- use ifThenElse instead+                if cacheRes then+                  Log.info "Saved into cache"+                else+                  pure ()+                return $ Right frame+              else do+                Log.info $ "Error happened: " <> tshow exitCode+                Log.info $ tshow stdErr+                return $ Left stdErr++    where+      cacheId = CacheId [path] "" "csv"+      opts :: TempFileOptions+      opts = TempFileOptions True+++-- buildTcpFrameFromFrame+-- \ Build a frame with only packets belonging to @streamId@+buildAFrameFromStreamIdTcp :: (Members [Log, Cache, Embed IO ] m)+    => TsharkParams+    -> FilePath+    -> StreamId Tcp+    -> Sem m (Either String (FrameFiltered TcpConnection Packet))+buildAFrameFromStreamIdTcp params pcapFilename streamId = do+    res <- loadPcapIntoFrame params pcapFilename+    return $ case res of+      Left err -> Left err+      Right frame -> buildTcpConnectionFromStreamId frame streamId++buildAFrameFromStreamIdMptcp :: (Members [Log, Cache, Embed IO ] m)+    => TsharkParams+    -> FilePath+    -> StreamId Mptcp+    -> Sem m (Either String (FrameFiltered MptcpConnection Packet))+buildAFrameFromStreamIdMptcp params pcapFilename streamId = do+  Log.debug  ("Building frame for mptcp stream " <> tshow streamId)+  res <- loadPcapIntoFrame params pcapFilename+  return $ case res of+    Left err -> Left err+    Right frame -> buildMptcpConnectionFromStreamId frame streamId
+ src/MptcpAnalyzer/Map.hs view
@@ -0,0 +1,107 @@+{-|+Module      : MptcpAnalyzer.Maps+Description : Maps Packets and Tcp streams between two frames+Maintainer  : matt+++Helper functions to map (mp)tcp.stream from one pcap to the one in another pcap.++For MPTCP, the association of mptcp.stream is done by identifying the same sendkey+in both pcaps.+For TCP, there is a similarity score computed on (IP, port) numbers. This could be+improved for sure (by comparing number of packets and other fields).++See "MptcpAnalyzer.Merge"+-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}+module MptcpAnalyzer.Map (+  mapMptcpConnection+  , mapTcpConnection+  , mapSubflows+  , showMptcpSubflowMapping+)+where++import MptcpAnalyzer.Cache+import MptcpAnalyzer.Loader+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Net.Mptcp+import Net.Tcp++import Data.Either (lefts, rights)+import Data.Function (on)+import Data.List (sortBy, sortOn)+import Data.Ord+import qualified Data.Set as Set+import Data.Text (Text, intercalate, unlines)+import qualified Data.Text as T+import Frames+import Options.Applicative+import Polysemy (Embed, Member, Members, Sem)+import qualified Polysemy as P+import Polysemy.State as P+import Prelude hiding (log)++type MptcpSubflowMapping = [(MptcpSubflow, [(MptcpSubflow, Int)])]++-- data MptcpSubflowMapping++-- | Returns+-- TODO we should sort the returned+mapSubflows :: MptcpConnection -> MptcpConnection -> MptcpSubflowMapping+mapSubflows con1 con2 =+  -- map selectBest (mpconSubflows con1)+  [ (sf1, scoreSubflows sf1) | sf1 <- Set.toList (_mpconSubflows con1) ]+  where+    -- select best / sortOn+    scoreSubflows sf1 = sortOn (Data.Ord.Down . snd) $+        map (\sf -> (sf, similarityScore sf1 sf)) (Set.toList $ _mpconSubflows con2)+++-- | show a mapping+showMptcpSubflowMapping :: MptcpSubflowMapping -> Text+showMptcpSubflowMapping m =+  T.unlines $ map showOneSfMapping m+  where+    showOneSfMapping (ref, scores) = "Mappings for " <> showMptcpSubflowText ref <> ":\n"+      <> (intercalate "\n-" $ map (\(sf, score) -> showMptcpSubflowText sf <> " SCORE: "<> tshow score) scores)+++-- | Ranks the pairings between TCP streams of two different pcaps+-- Returns a list of+mapTcpConnection ::+  -- Members '[Log String, P.State MyState, Cache, Embed IO] r =>+  FrameFiltered TcpConnection Packet+  -> Frame Packet+  -> [(TcpConnection, Int)]+  -- ^ (connection, score)+mapTcpConnection aframe frame = let+      streamsToCompare = getTcpStreams frame+      consToCompare = map (buildTcpConnectionFromStreamId frame) (getTcpStreams frame)+      scores = map (evalScore (ffCon aframe)) (rights consToCompare)+      sortedScores = sortOn (Data.Ord.Down . snd) scores+      evalScore con1 (FrameTcp con2 _) = (con2, similarityScore con1 con2)+    in+      sortedScores++-- |+-- map_mptcp_connection_from_known_streams+mapMptcpConnection ::+  FrameFiltered MptcpConnection Packet+  -> Frame Packet+  -> [(MptcpConnection, Int)]+  -- ^ (connection, score)+mapMptcpConnection aframe frame = let+      streamsToCompare = getMptcpStreams frame+      consToCompare = map (buildMptcpConnectionFromStreamId frame) (getMptcpStreams frame)+      scores = map (evalScore (ffCon aframe)) (rights consToCompare)+      sortedScores = sortOn (Data.Ord.Down . snd) scores+      -- sortedScores = reverse $ sortOn snd scores+      evalScore con1 (FrameTcp con2 _) = (con2, similarityScore con1 con2)+    in+      sortedScores
+ src/MptcpAnalyzer/Merge.hs view
@@ -0,0 +1,505 @@+{-|+Module      : MptcpAnalyzer.Merge+Description : Merges 2 dataframes into a single one with the format sender -> receiver+Maintainer  : matt+License     : GPL-3++To compute some statistics, it is necessary+to be able to map packets captured on the server to the ones mapped on the client.++For instance if clocks on both hosts are synchronized and we know the mapping, we can compute the One-Way-Delay (OWD).+It is usually assumed to be half the roundtrip, also because there is almost no tooling to measure it.++Another example where it is useful is when dealing with retransmissions, you may want+to identify what transmission arrived first in order to classify between successful+and penalizing retransmissons.+A similar analysis applies to MPTCP streams as reinjections can happen cross-subflows.+If we can distinguish the first successful transmission from the redundant ones,+it becomes possible to compute the real contribution ("goodput") of a subflow to+the overall MPTCP transmission.+We can thus compare different retransmissions schemes, a crucial area of research+in the MPTCP community.++You can easily generate retransmissions using the "redundant scheduler".++-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -O0 #-}+module MptcpAnalyzer.Merge (+  mergeTcpConnectionsFromKnownStreams+  , mergeMptcpConnectionsFromKnownStreams+  , convertToSenderReceiver++  -- * Types+  , SenderReceiverCols+  , TcpSenderReceiverCols+  , MptcpSenderReceiverCols+  , MergedFrame+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Types+import Prelude hiding (log)+import Tshark.TH+-- for retypeColumn+-- import MptcpAnalyzer.Frames.Utils+import MptcpAnalyzer.Map+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Utils.Text+-- (addTcpDestToFrame, StreamConnection)+import Net.IP (IP)+import Net.Tcp+++import Control.Lens+import Data.Either (fromRight)+import Data.Foldable (toList)+import Data.Hashable+import Data.List (intercalate, intersperse, sortBy, sortOn)+import Data.Maybe (catMaybes)+import Data.Vinyl+import qualified Data.Vinyl as V+import Data.Vinyl.TypeLevel as V+import Data.Word (Word16, Word32, Word64, Word8)+import Frames as F+import Frames.CSV+import Frames.Joins+import Frames.Melt (ElemOf, RDeleteAll)+import GHC.TypeLits (KnownSymbol, Symbol)+import Language.Haskell.TH (Name)+import Net.Mptcp++import qualified Control.Foldl as L+import qualified Data.Foldable as F+import qualified Pipes+import qualified Pipes.Prelude as Pipes+import Polysemy+import qualified Polysemy.Embed as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log++-- convert_to_sender_receiver+-- merge_tcp_dataframes_known_streams(+-- map_tcp_packets_via_hash+-- map_mptcp_connection_from_known_streams(+-- classify reinjections++-- PacketMerged should be TCP/MPTCP+++-- TODO use inner join / outer join hash+-- mapMptcpConnectionsFromKnownStreams :: FrameFiltered Packet -> FrameFiltered Packet -> FrameFiltered PacketMerged+-- mapMptcpConnectionsFromKnownStreams =++type Score = Int+++-- def map_mptcp_connection_from_known_streams(+--     main: MpTcpConnection,+--     other: MpTcpConnection+-- ) -> MpTcpMapping:+--     """+--     Attempts to map subflows only if score is high enough+--     """+--     def _map_subflows(main: MpTcpConnection, mapped: MpTcpConnection):+--         """+--         """+--         mapped_subflows = []+--         for sf in main.subflows():++--             # generates a list (subflow, score)+--             scores = list(map(lambda x: TcpMapping(x, sf.score(x)), mapped.subflows()))+--             scores.sort(key=lambda x: x.score, reverse=True)+--             log.log(mp.TRACE, "sorted scores when mapping %s:\n %r" % (sf, scores))+--             mapped_subflows.append((sf, scores[0]))+--         return mapped_subflows++--     mptcpscore = main.score(other)+--     mapped_subflows = None+--     if mptcpscore > float('-inf'):+--         # (other, score)+--         mapped_subflows = _map_subflows(main, other)++--     mapping = MpTcpMapping(mapped=other, score=mptcpscore, subflow_mappings=mapped_subflows)+--     log.log(mp.TRACE, "mptcp mapping %s", mapping)+--     return mapping++++-- prefix+-- type PacketMerged =+toHashablePacket :: Record HostCols -> Record HashablePart+toHashablePacket = rcast++-- instance Hashable (Rec ElField a) where++-- -- TODO should generate a column and add it back to HostCols+-- -- type FieldRec = Rec ElField+-- addHash :: FrameFiltered Packet -> Frame (Record (PacketHash ': HashablePart))+-- addHash aframe =+--   fmap (addHash')  ( frame)+--   where+--     frame = fmap toHashablePacket (ffFrame aframe)+--     addHash' row = Col (hashWithSalt 0 row) :& row++-- generate a column and add it back to HostCols+addHash :: StreamConnection a b => FrameFiltered a Packet -> Frame (Record '[PacketHash] )+addHash aframe =+  -- addHashToFrame (ffFrame aframe)+  fmap addHash'  frame+  where+    frame = fmap toHashablePacket (ffFrame aframe)+    addHash' row = Col (hash row) :& RNil++addHashToFrame :: Frame Packet -> Frame (Record '[PacketHash] )+addHashToFrame frame =+  fmap (addHash')  (frame')+  where+    frame' = fmap toHashablePacket frame+    addHash' row = Col (hash row) :& RNil+++-- '[TcpDest] V.+++type MergedHostCols = PacketHash ': '[SenderDest] V.++ HostCols V.++ HostColsPrefixed+type MergedHostColsMptcp = PacketHash ': '[SenderDest] V.++ HostCols V.++ HostColsPrefixed++-- not a frame but hope it should be+-- type MergedPcap a = [Rec (Maybe :. ElField) a]+type MergedPcap = [Rec (Maybe :. ElField) MergedHostCols]++type MergedFrame = FrameRec MergedHostCols+-- type MergedFrameTcp = FrameRec (TcpDest ': MergedHostCols)+-- type MergedFrameMptcp = FrameRec (MptcpDest ': MergedHostCols)++-- liste de+mergedPcapToFrame :: MergedPcap -> (FrameRec MergedHostCols, MergedPcap)+mergedPcapToFrame mergedRes = let+  -- P.embed $ putStrLn $ "There are " ++ show (length justRecs) ++ " valid merged rows (out of " ++ show (length mergedRes) ++ " merged rows)"+  -- P.embed $ putStrLn $ (concat . showFields) (head justRecs)+    mbRecs = map recMaybe mergedRes+    justRecs = catMaybes mbRecs+  in+    (toFrame justRecs, [])+++writeMergedPcap :: FilePath -> MergedPcap -> IO ()+writeMergedPcap outPath mergedPcap = do+  -- showReinjects frame =+    -- unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)+    writeFile outPath content+    where+      content = intercalate "," rows+      rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) mergedPcap)+++showMergedRes :: MergedPcap -> String+showMergedRes mergedPcap = do+  -- showReinjects frame =+    -- unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)+    -- writeFile outPath content+    content+    where+      content = intercalate "\n" rows+      rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) mergedPcap)++--+-- | Drop a column from a record.  Just a specialization of rcast.+dropColumn :: forall x rs. (F.RDelete x rs F.⊆ rs) => F.Record rs -> F.Record (F.RDelete x rs)+dropColumn = F.rcast+++-- | Merge of 2 frames+-- TODO add MptcpDest+mergeMptcpConnectionsFromKnownStreams ::+  (Members '[Log, P.Embed IO] r)+  => FrameFiltered MptcpConnection Packet+  -> FrameFiltered MptcpConnection Packet+  -> Sem r MergedFrame+  -- ^ merged frame+mergeMptcpConnectionsFromKnownStreams (FrameTcp con1 frame1) (FrameTcp con2 frame2) = do+  let mappedSubflows = mapSubflows con1 con2+  Log.info $ "Merging MPTCP frame1 " <> tshow (frameLength frame1) <> " and frame2 " <> tshow (frameLength frame2)+  Log.info $ "Mapped subflows:\n" <> showMptcpSubflowMapping mappedSubflows+  -- mergedFrames = map+  mergedFrames <- mapM  mergeSubflow mappedSubflows+  -- Log.info $ tshow (length mergedPackets) <> " merged lists"+  let res = mconcat mergedFrames+  Log.info $ tshow (frameLength res) <> " concatenated merged packets"+  return res+  where+    -- convertDest :: Record (MptcpDest ': TcpDest ': HostCols) -> Record (SenderDest ': HostCols)+    -- convertDest = withNames . stripNames+    convertDest :: Record '[MptcpDest] -> Record '[SenderDest]+    convertDest = withNames . stripNames++    -- frameWithDests = addMptcpDest frame1 con1++    -- frameWithSenderDest :: FrameRec (MptcpDest ': TcpDest ': HostCols) -> FrameRec (SenderDest ': HostCols)+    -- frameWithSenderDest = fmap convertDest frameWithDests++    -- mergeSubflow :: (MptcpSubflow, [(MptcpSubflow, Int)]) -> MergedPcap+    mergeSubflow (sf1, scores) = do+      Log.debug $ "Merging pcap1 " <> tshow streamId1 <> " (" <> tshow (frameLength $ ffFrame aframe1)+          <> " packets) and " <> tshow streamId2 <> " (" <> tshow (frameLength $ ffFrame aframe2) <> " packets)"++      -- TODO add MptcpDest and recast to senderDest+      -- addMptcpDestToSubflowFrame+      mergedSf <- mergeTcpSubflowFromKnownStreams+            (FrameTcp (ffCon aframe1) (zipFrames aframe1Dest (ffFrame aframe1)))+            aframe2+      -- TODO print justRecs /+      -- let+      --   mbRecs = map recMaybe mergedSf+      --   justRecs = catMaybes mbRecs+      -- -- Log.debug $ "Merging pcap1 stream" <> tshow streamId1 <> " (" <> tshow (frameLength frame1)+      --     -- <> " packets) and " <> tshow streamId2 <> " (" <> tshow (frameLength frame2) <> " packets)"+      -- Log.debug $ "There are " <> tshow (length justRecs) <> " valid rows (out of "+      --   <> tshow (length mergedSf) <> " merged rows)"+      -- Log.debug $ (concat . showFields) (head justRecs)++      return mergedSf+      where+        streamId1 = conTcpStreamId $ sfConn sf1+        -- here we assume it's ordered but it might not be the case+        streamId2 = conTcpStreamId $ sfConn $ fst (head scores)++        aframe1 = fromRight undefined (buildFrameFromStreamId frame1 streamId1)+        aframe2 = fromRight undefined (buildFrameFromStreamId frame2 streamId2)++        aframe1Dest = fmap convertDest (addMptcpDestToFrame con1 aframe1)++-- mergeMptcpConnectionsFromKnownStreams' ::+--   FrameFiltered MptcpConnection Packet+--   -> FrameFiltered MptcpConnection Packet+--   -> MergedPcap+-- mergeMptcpConnectionsFromKnownStreams' (FrameTcp con1 frame1) (FrameTcp con2 frame2) = let+--   -- first we need to map subflow to oneanother+--   -- map mpconSubflows+--     mappedSubflows = mapSubflows con1 con2+--     mergedFrames = map mergeSubflow mappedSubflows++--     -- aframeSf1 = buildFrameFromStreamId frame1 (conTcpStreamId $ sfConn con1)+--     -- aframeSf1 = buildFrameFromStreamId frame2 (conTcpStreamId $ sfConn con1)+--     -- sf1 = buildTcpConnectionFromStreamId (++--     -- :: MptcpSubflow ->+--     mergeSubflow :: (MptcpSubflow, [(MptcpSubflow, Int)]) -> MergedPcap+--     mergeSubflow (sf1, scores) = mergeTcpConnectionsFromKnownStreams' aframe1 aframe2+--       where+--         aframe1 = fromRight undefined (buildFrameFromStreamId frame1 (conTcpStreamId $ sfConn sf1) )+--         aframe2 = fromRight undefined (buildFrameFromStreamId frame2 (conTcpStreamId $ sfConn $ fst (head scores ) ))+--                                     -- (FrameFiltered (sfConn sf) frame1)+--                                     -- (FrameFiltered (sfConn sf) frame2)+--   in+--     mconcat mergedFrames+++validateMergedRes ::+  (Members '[Log, P.Embed IO] r)+  => MergedPcap+  -> Sem r Bool+validateMergedRes l = do+  Log.debug "validating mergedRes"+  -- rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) mergedPcap)+  -- return $ L.nub (view packetId <$> l) /= length l+  return True++-- mergeTcpSubflow ::+++mergeTcpSubflowFromKnownStreams ::+  (Members '[Log, P.Embed IO] r)+  => FrameFiltered MptcpSubflow PacketWithSenderDest+  -> FrameFiltered MptcpSubflow Packet+  -> Sem r MergedFrame+mergeTcpSubflowFromKnownStreams (FrameTcp sfcon1 frame1) (FrameTcp sfcon2 frame2) =+  mergeTcpConnectionsFromKnownStreams (FrameTcp (sfConn sfcon1) frame1)+      (FrameTcp (sfConn sfcon2) frame2)++-- | Merge 2 pcaps+mergeTcpConnectionsFromKnownStreams ::+  (Members '[Log, P.Embed IO] r)+  => FrameFiltered TcpConnection PacketWithSenderDest+  -> FrameFiltered TcpConnection Packet+  -> Sem r MergedFrame+-- these are from host1 / host2+mergeTcpConnectionsFromKnownStreams aframe1 aframe2 = do+  Log.debug $ "Merging stream " <> showConnectionText (ffCon aframe1) <> " with stream "+  -- Ziggy Marley+  embed $ writeDSV defaultParserOptions out1 hframe1+  embed $ writeDSV defaultParserOptions out2 hframe2++  return $ (fst . mergedPcapToFrame) mergedRes+  where+    -- frame1withDest = addTcpDestToFrame (ffFrame aframe1) (ffCon aframe1)+    frame1withDest = ffFrame aframe1++    out1 = "merge-tcp-1-stream-" ++ show ((conTcpStreamId . ffCon) aframe1) ++ ".tsv"+    out2 = "merge-tcp-2-stream-" ++ show (conTcpStreamId $ ffCon aframe2) ++ ".tsv"++    -- we want an outerJoin , maybe with a status column like in panda+    -- outerJoin returns a list of [Rec (Maybe :. ElField) ors]+    mergedRes = leftJoin @'[PacketHash] (hframe1dest) processedFrame2+++    -- (rcast @HostCols )+    -- hframe1 = zipFrames (addHash $ fmap (rcast @Packet) (ffFrame aframe1)) (ffFrame aframe1)+    hframe1 = zipFrames (addHashToFrame $ fmap (rcast @HostCols) (ffFrame aframe1)) (ffFrame aframe1)+    hframe1dest = hframe1+    -- hframe1dest = addTcpDestinationsToAFrame hframe1+    hframe2 :: Frame (Record ('[PacketHash] ++ HostColsPrefixed))+    hframe2 = zipFrames (addHash aframe2) host2_frame++    host2_frame = convertToHost2Cols (ffFrame aframe2)+    processedFrame2 = hframe2+++-- | Merge of 2 frames+-- inspired by merge_tcp_dataframes_known_streams+-- mergeTcpConnectionsFromKnownStreams' ::+--   FrameFiltered TcpConnection Packet+--   -> FrameFiltered TcpConnection Packet+--   -> MergedPcap+-- -- these are from host1 / host2+-- mergeTcpConnectionsFromKnownStreams' aframe1 aframe2 =+--   mergedFrame+--   where+--     -- (Record HostColsPrefixed)+--     -- we want an outerJoin , maybe with a status column like in panda+--     -- outerJoin returns a list of [Rec (Maybe :. ElField) ors]+--     mergedFrame = outerJoin @'[PacketHash] (hframe1dest) processedFrame2++--     frame1withDest = addTcpDestToFrame (ffFrame aframe1) (ffCon aframe1)++--     hframe1 = zipFrames (addHash aframe1) frame1withDest+--     hframe1dest = hframe1+--     -- hframe1dest = addTcpDestinationsToAFrame hframe1+--     hframe2 :: Frame (Record ('[PacketHash] ++ HostColsPrefixed))+--     hframe2 = zipFrames (addHash aframe2) host2_frame++--     host2_frame = convertToHost2Cols (ffFrame aframe2)+--     processedFrame2 = hframe2++-- | Result of the merge of 2 pcaps+-- genExplicitRecord "" "HostCols" mergedFields++-- gen https://hackage.haskell.org/package/vinyl-0.13.1/docs/Data-Vinyl-Derived.html+convertToHost2Cols :: FrameRec HostCols -> FrameRec HostColsPrefixed+convertToHost2Cols = fmap convertCols'+  where+    convertCols' :: Record HostCols -> Record HostColsPrefixed+    convertCols' = withNames . stripNames+    -- if you need a review on a specific patch, let us know+    -- stripNames r+    -- convertCols' r = F.rcast @HostColsPrefixed (retypeColumns @'[ '("fakePacketId", "fake_fakePacketId", Word64), '("fakeInterfaceName", "fake_fakeInterfaceName", Text) ] r)++-- convertCols :: Record a -> Record b+-- convertCols = withNames . stripNames++-- TODO and then we should compute a owd+-- , RcvAbsTime+-- type SenderReceiverCols =  '[SndPacketId, RcvPacketId, SndAbsTime, RcvAbsTime, TcpDest]+-- TODO il nous faut le hash + la dest+-- | SenderHost+type TcpSenderReceiverCols =  SenderHost ': TcpDest ': SenderCols V.++ ReceiverCols+type SenderReceiverCols =  SenderHost ': SenderDest ': SenderCols V.++ ReceiverCols+type MptcpSenderReceiverCols =  SenderHost ': MptcpDest ': SenderCols V.++ ReceiverCols++++-- FrameMergedOriented+-- inspirted by convert_to_sender_receiver+-- TODO this should be for a TCP frame+--+-- In the mergedpcap we have mapped packets from 2 hosts. We then have to decide+-- between the 2 hosts which one acted as a client and which one as the server.+--+-- @param j+--  Convert dataframe from  X_HOST1 ': X_HOST2 to X_SENDER ': X_RECEIVER+--  Each mapping PACKET_HOST_1 <-> PACKET_HOST_2 is associated with its destination Server/Client+--  We thus need to find out which host acted as a Client or Server;+--  then we can select packets whose destination is the Server+--  and for those packets set the Sender to HOST1 or HOST2+--+-- 1/ we compare the abstime of the first packet (TODO we could select the role instead ?!)+convertToSenderReceiver ::+  MergedFrame+  -> FrameRec SenderReceiverCols+convertToSenderReceiver oframe = do+  -- compare first packet time+  if delta > 0 then+    -- host1 is the client+    -- then rename into sndTime, rcvTime+    -- TODO+    -- convertHost1AsClient+    setHost1AsSenderForDest RoleServer <> setHost2AsSenderForDest RoleClient+  else+    -- TODO zarb because it's the same as before+    setHost1AsSenderForDest RoleServer <> setHost2AsSenderForDest RoleClient++  where+    -- tframe :: [Maybe (Record MergedHostCols)]+    -- tframe = fmap recMaybe oframe++    -- jframe :: FrameRec MergedHostCols+    -- jframe = toFrame $ catMaybes $ toList tframe+    jframe = oframe++    firstRow = frameRow jframe 0++    -- instead of taking firstRow we should compare the minima in case there are retransmissions+    delta :: Double+    delta =  (firstRow ^. testAbsTime) - (firstRow ^. absTime)++    selectDest :: ConnectionRole -> FrameRec MergedHostCols+    selectDest dest = filterFrame (\x -> x ^. senderDest == dest) jframe++    -- em fait le retype va ajouter la colonne a la fin seulement+    -- zipFrames+    setHost1AsSenderForDest, setHost2AsSenderForDest  :: ConnectionRole -> FrameRec SenderReceiverCols+    setHost1AsSenderForDest dest = fmap (\x -> Col False :& convertToSender x ) (selectDest dest)++    -- (if h1role == RoleClient then RoleServer else RoleClient))+    setHost2AsSenderForDest  dest = fmap (\x -> Col True :& convertToReceiver x ) (selectDest dest)++    -- convertToSender, convertToReceiver :: Record MergedHostCols -> Record SenderReceiverCols+    convertToSender r = let+        -- TODO add tcpDest+        senderCols :: Record SenderCols+        senderCols = (withNames . stripNames . F.rcast @HostCols) r+        receiverCols :: Record ReceiverCols+        receiverCols = (withNames . stripNames . F.rcast @HostColsPrefixed) r+      in+        rget @SenderDest r :& rappend senderCols receiverCols++    convertToReceiver r = let+        senderCols :: Record SenderCols+        senderCols = (withNames . stripNames . F.rcast @HostColsPrefixed) r+        receiverCols :: Record ReceiverCols+        receiverCols = (withNames . stripNames . F.rcast @HostCols) r+      in+        rget @SenderDest r :& rappend senderCols receiverCols+        -- convert ("first host") to sender/receiver+        -- TODO this could be improved+++-- | Add a One-Way-Delay column to the results+-- addOWD :: Frame (Record RecSenderReceiver) -> Frame (Record '[OWD] ++ RecSenderReceiver)+-- addOWD = fmap addOWD'+--   where+--     addOWD' = (rcvAbsTime x - sndAbsTime x)
+ src/MptcpAnalyzer/Pcap.hs view
@@ -0,0 +1,659 @@+{-|+Module: MptcpAnalyzer.Pcap+Maintainer  : matt+License     : GPL-3++Pot-pourri+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE PackageImports #-}+module MptcpAnalyzer.Pcap (+    addTcpDestToFrame+    , addMptcpDestToFrame+    , addMptcpDest+    , addTcpDestinationsToAFrame+    , buildTcpConnectionFromStreamId+    , buildMptcpConnectionFromStreamId+    , defaultParserOptions+    , genTcpDestFrame+    , genTcpDestFrameFromAFrame+    , exportToCsv+    , loadRows+    , getTcpStreams+    , getMptcpStreams+    , buildSubflowFromRecord+    , buildSubflowFromTcpStreamId+    , buildTcpConnectionFromRecord+    , buildTcpConnectionTupleFromRecord++    , genMptcpEndpointConfigFromRow +    -- TODO remove ? use instance instead+    , showMptcpSubflowText+    , StreamConnection(..)+    , showConnection+    , scoreTcpCon+    , scoreMptcpCon+    -- , showMptcpSubflowText+    )+where+++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Net.Mptcp.Connection+import Net.Tcp+import Net.Stream+import Net.Tcp.Constants (TcpFlag(..))+import Tshark.Fields+import Tshark.TH++-- hackage+import Control.Lens ((^.))+import Data.Kind (Type)+import Data.Monoid (First(..))+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Vector as V+import Frames+import Frames.CSV+       ( ParserOptions(..)+       , QuotingMode(..)+       , ReadRec+       , pipeTableEitherOpt+       , produceTextLines+       , readFileLatin1Ln+       , readTableMaybeOpt+       )+import Frames.Col+import Frames.ColumnTypeable (Parseable(..), Parsed(..), parseIntish)+import Frames.ShowCSV+import Frames.TH+import System.Exit+import System.IO+       ( BufferMode(LineBuffering)+       , Handle+       , SeekMode(AbsoluteSeek)+       , hGetContents+       , hSeek+       , hSetBuffering+       )+import System.Process+-- for Record+-- import Frames.Rec (Record(..))+import Data.List (intercalate)+import Net.IP+-- for symbol+-- import GHC.Types+import qualified Control.Foldl as L+import qualified Data.Set as Set+-- import Language.Haskell.TH+-- import Language.Haskell.TH.Syntax+-- import Lens.Micro+-- import Lens.Micro.Extras+import Control.Lens+import qualified Data.Foldable as F+import Data.Maybe (catMaybes, fromJust, isNothing)+import Data.Vinyl (ElField(..), Rec(..), rapply, rmapX, xrec)+import Data.Vinyl.Class.Method+import Data.Vinyl.Functor (Compose(..), (:.))+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Base (Symbol)+import GHC.List (foldl')+import GHC.TypeLits (KnownSymbol)+import Numeric (readHex)+import Pipes (Producer, cat, (>->))+import qualified Pipes.Prelude as P+-- import qualified Frames.InCore+import Control.Exception (assert)+import Data.Either (lefts, rights)+import qualified Data.Map as Map+import Debug.Trace+import qualified Frames.InCore as I+import GHC.IO.Handle (hClose)+import System.Environment (getEnvironment)+import System.IO.Temp+import Tshark.Main++-- tableTypes is a Template Haskell function, which means that it is executed at compile time. It generates a data type for our CSV, so we have everything under control with our types.+++-- on veut la generer+-- [[t|Ident Int|], [t|Happiness|]]+-- tableTypesExplicit' :: [Q Type] -> RowGen a -> FilePath -> DecsQ+-- tableTypesExplicit'++-- tableTypesExplicit'+--   (getTypes baseFields)+--   -- [ Field Word64 ]+--   -- [[t| Word64|]]+--   ((rowGen "data/test-1col.csv")+--   { rowTypeName = "Packet"+--         , separator = ","+--         -- TODO I could generate it as well+--         -- , columnNames+--     })+--     -- path+--     "data/test-simple.csv"++++-- shadow type to know if it was filtered or not+-- Make it a record ?+-- first argument allows to override csv header ("headerOverride")+defaultParserOptions :: ParserOptions+defaultParserOptions = ParserOptions Nothing (T.pack [csvDelimiter defaultTsharkPrefs]) NoQuoting++-- nub => remove duplicates+-- or just get the column+getTcpStreams :: FrameRec HostCols -> [StreamIdTcp]+getTcpStreams ps = L.fold L.nub (view tcpStream <$> ps)++-- | to list+getMptcpStreams :: FrameRec HostCols -> [StreamId Mptcp]+getMptcpStreams ps = L.fold L.nub $ catMaybes $ F.toList (view mptcpStream <$> ps)+-- filterFrame  (\x -> x ^. mptcpStream == Just streamId) frame++++{- Export to CSV+sets WIRESHARK_CONFIG_DIR so that the user profile doesn't influence the output+-}+exportToCsv ::+  TsharkParams+  -> FilePath  -- ^Path to the pcap+  -> Handle -- ^ temporary file+-- ^See haskell:readCreateProcessWithExitCode+  -> IO (ExitCode, String)+exportToCsv params pcapPath tmpFileHandle = do+    curEnv <- getEnvironment+    withSystemTempFile "tshark-profile" $ \tempDir _ -> do+      let+          (RawCommand bin args) = generateCsvCommand fields (Right pcapPath) (params )+          createProc :: CreateProcess+          createProc = (proc bin args) {+              std_err = CreatePipe,+              std_out = UseHandle tmpFileHandle,+              env = Just $ curEnv ++ [ ("WIRESHARK_CONFIG_DIR", tempDir) ],+              delegate_ctlc = True+              }+      putStrLn $ "Exporting fields " ++ show fields+      putStrLn $ "Command run: " ++ show (RawCommand bin args)+      -- TODO redirect stdout towards the out handle+      hSetBuffering tmpFileHandle LineBuffering+      hSeek tmpFileHandle AbsoluteSeek 0 >> T.hPutStrLn tmpFileHandle fieldHeader+      (_, _, Just herr, ph) <-  createProcess_ "error" createProc+      exitCode <- waitForProcess ph+      -- TODO do it only in case of error ?+      err <- hGetContents herr+      hClose herr+      return (exitCode, err)+    where+      fields :: [T.Text]+      fields = Map.elems $ Map.map tfieldFullname baseFields++      csvSeparator = T.pack [csvDelimiter params]+      fieldHeader :: Text+      fieldHeader = T.intercalate csvSeparator (Map.keys baseFields)+++loadRows :: (I.RecVec a, ReadRec a) => FilePath -> IO (FrameRec a)+loadRows path = inCoreAoS (+  eitherProcessed path+  )+++type ManEither = Rec (Either T.Text :. ElField) (RecordColumns Packet)++-- pipteTable will tokenize on its own+-- loadRowsEither :: MonadSafe m => FilePath -> Producer ManEither m ()+-- loadRowsEither path =  produceTextLines path >-> pipeTableEitherOpt defaultParserOptions++{- |Load rows and errors when it can't load a specific line+-}+eitherProcessed :: (ReadRec a, MonadSafe m) => FilePath -> Producer (Record a) m ()+eitherProcessed path = produceTextLines path+  >-> pipeTableEitherOpt defaultParserOptions >-> P.map fromEither+  where+    -- fromEither :: Rec (Either Text :. ElField) (RecordColumns Packet) -> Packet+    fromEither x = case recEither x of+      Left _txt -> error ( "eitherProcessed failure : " ++ T.unpack _txt)+      Right pkt -> pkt++    recEither = rtraverse getCompose++-- | Undistribute 'Maybe' from a 'Rec' 'Maybe'. This is just a+-- specific usage of 'rtraverse', but it is quite common.+-- recEither :: Rec (Either Text :. ElField) cs -> Either Text (Record cs)+-- recEither = rtraverse getCompose++-- data TsharkPrefs = TsharkPrefs {+--     analyzeTcpSeq :: Bool+--     , analyzeMptcp :: Bool+--     , mptcpRelSeq :: Bool+--     , analyzeMptcp :: Bool+--   } deriving Show++{-+-}+getTcpFrame :: FrameRec HostCols -> StreamId Tcp -> Either String (FrameFiltered TcpConnection Packet)+getTcpFrame = buildTcpConnectionFromStreamId++-- | For now assume the packet is the first syn from client to server+-- TODO this is wrong, assumes source ip is client, convert to return a TcpConnectionOriented+buildTcpConnectionFromRecord :: (+  IpFields rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs+  ) => Record rs -> TcpConnection+buildTcpConnectionFromRecord r =+  TcpConnection {+      conTcpClientIp = r ^. ipSource+    , conTcpServerIp = r ^. ipDest+    , conTcpClientPort = r ^. tcpSrcPort+    , conTcpServerPort = r ^. tcpDestPort+    , conTcpStreamId = r ^. tcpStream+  }++buildTcpConnectionTupleFromRecord :: (+  IpFields rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs+  ) => Record rs -> TcpConnectionOriented+buildTcpConnectionTupleFromRecord r =+  TcpConnectionOriented {+      conTcpSourceIp = r ^. ipSource+    , conTcpDestinationIp = r ^. ipDest+    , conTcpSourcePort = r ^. tcpSrcPort+    , conTcpDestinationPort = r ^. tcpDestPort+    -- , conTcpStreamId = r ^. tcpStream+  }++{- Builds a Tcp connection from a non filtered frame+-}+buildTcpConnectionFromStreamId ::+  FrameRec HostCols+  -> StreamId Tcp -> Either String (FrameFiltered TcpConnection Packet)+buildTcpConnectionFromStreamId frame streamId =+    if frameLength synPackets < 1 then+      Left $ "No packet with any SYN flag for tcp.stream " ++ show streamId+    else+      -- TODO check who is client+      Right $ FrameTcp (buildTcpConnectionFromRecord $ frameRow synPackets 0) streamPackets+    where+      streamPackets = filterFrame  (\x -> x ^. tcpStream == streamId) frame+      synPackets = filterFrame (\x -> TcpFlagSyn `elem` (x ^. tcpFlags)) streamPackets+++-- |+-- buildMasterSubflowFromRecord ::+++-- | Builds+-- should expect a filteredFrame with MPTCP+-- buildSubflowFromTcpStreamId :: FrameFiltered TcpConnection Packet -> StreamId Tcp -> Either String (FrameFiltered MptcpSubflow Packet)+buildSubflowFromRecord :: Packet -> MptcpSubflow+buildSubflowFromRecord row =+  MptcpSubflow {+          sfConn = sfCon+        -- TODO ignore if it's master token+        , sfJoinToken = row ^. mptcpRecvToken+        , sfPriority = Nothing+        -- TODO+        , sfLocalId = 0+        , sfRemoteId = 0+        -- todo load it from row+        , sfInterface = Nothing+      }+  where+      sfCon = buildTcpConnectionFromRecord row+++buildSubflowFromTcpStreamId ::+  (+  rs ⊆ HostCols+  , I.RecVec rs+  , TcpFlags ∈ rs , TcpStream ∈ rs, MptcpRecvToken ∈ rs+  , IpSource ∈ rs, IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs+  )+  => FrameRec rs+  -> StreamId Tcp+  -> Either String (FrameFiltered MptcpSubflow (Record rs))+buildSubflowFromTcpStreamId frame streamId =+    if frameLength synPackets < 1 then+      Left $ "No packet with any SYN flag for tcp.stream " ++ show streamId+    else+      -- TODO check who is client+      Right $ FrameTcp sf streamPackets+    where+      syn0 = frameRow synPackets 0+      streamPackets = filterFrame  (\x -> x ^. tcpStream == streamId) frame+      synPackets = filterFrame (\x -> TcpFlagSyn `elem` (x ^. tcpFlags)) streamPackets+      sfCon = buildTcpConnectionFromRecord syn0+      -- rcvToken+      sf = MptcpSubflow {+        sfConn = sfCon+        -- TODO ignore if it's master token+        , sfJoinToken = syn0 ^. mptcpRecvToken+        , sfPriority = Nothing+        , sfLocalId = 0+        , sfRemoteId = 0+        , sfInterface = Nothing+      }++-- | Sets mptcp role column+-- TODO maybe je devrais juste generer un+addMptcpDest ::+    (+      -- Frames.InCore.RecVec rs,+      -- HostCols ⊆ rs+      -- MptcpStream ∈ rs, TcpStream  ∈ rs, IpSource ∈ rs, IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs+      -- rs = HostCols+      ) =>+      Frame (Record HostCols)+      -> MptcpConnection+      -> FrameRec  (+            MptcpDest ': TcpDest ': HostCols+          )+addMptcpDest frame con =+    -- foldl' (\tframe sf -> addDestToFrame tframe sf) startingFrame subflows+    mconcat subflowFrames+    where+      -- filteredFrame = filterFrame  (\x -> x ^. mptcpStream == Just (mpconStreamId con)) frame+      -- filteredFrame = filterFrame  (\x -> (rgetField @MptcpStream x) == Just (mpconStreamId con)) frame++      subflowFrames = map addDestsToSubflowFrames subflows++      addDestsToSubflowFrames sf = addMptcpDestToFrame' (addTcpDestToFrame frame (sfConn sf)) sf++      addMptcpDest' role x = Col role :& x++      addMptcpDestToFrame' frame' sf = fmap (addMptcpDest' (getMptcpDest con sf)) frame'++      startingFrame = fmap setTempDests frame+      setTempDests :: Record rs -> Record ( MptcpDest ': TcpDest ': rs)+      setTempDests x = Col RoleClient :& Col RoleClient :& x+      addMptcpDestToRec x role = Col role :& x+      subflows = Set.toList $ _mpconSubflows con++addMptcpDestToFrame :: MptcpConnection -> FrameFiltered MptcpSubflow Packet -> FrameRec '[MptcpDest]+addMptcpDestToFrame mpcon (FrameTcp sf frame) = fmap (addMptcpDest' (getMptcpDest mpcon sf)) frame+  where+      addMptcpDest' role x = Col role :& RNil+++getMptcpDest :: MptcpConnection -> MptcpSubflow -> ConnectionRole+getMptcpDest mptcpCon sf = case sfJoinToken sf of+  -- master subflow, dest is by definition the server+  Nothing -> RoleServer+  Just token -> if token == (_mecToken . _mpconServerConfig) mptcpCon then+    RoleServer+  else+    RoleClient+++-- | Sets TCP role column+-- append a column with a value role+-- Todo accept a 'FrameFiltered'+-- I want to check it is included+-- TODO add an unsafe version ?+addTcpDestToFrame :: (+  I.RecVec rs+  ,IpSource ∈ rs, IpDest ∈ rs+  , IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs+  , TcpStream ∈ rs+  )+    => FrameRec rs+    -> TcpConnection+    -> FrameRec ( TcpDest ': rs )+addTcpDestToFrame frame con = do+  assert+    -- check that they all belong to the same stream+    (length ( L.fold L.nub (view tcpStream <$> frame)) == 1)+    fmap (\x -> addTcpDestToRec x (computeTcpDest x con)) streamFrame+  where+    streamFrame = frame+++-- | Generates a frame with a single column containing the TcpDest+genTcpDestFrame :: (+  I.RecVec rs+  , IpSource ∈ rs, IpDest ∈ rs+  , TcpSrcPort ∈ rs, TcpDestPort ∈ rs+  , TcpStream ∈ rs+  )+    => FrameRec rs+    -> TcpConnection+    -> FrameRec '[TcpDest]+genTcpDestFrame frame con = fmap (\x -> Col (computeTcpDest x con) :& RNil) streamFrame+    where+      streamFrame = filterFrame  (\x -> rgetField @TcpStream x == conTcpStreamId con) frame++genTcpDestFrameFromAFrame :: (+  I.RecVec rs+  , IpSource ∈ rs, IpDest ∈ rs+  , TcpSrcPort ∈ rs, TcpDestPort ∈ rs+  , TcpStream ∈ rs+  )+    => FrameFiltered TcpConnection (Record rs)+    -> FrameRec '[TcpDest]+genTcpDestFrameFromAFrame aframe = genTcpDestFrame (ffFrame aframe) (ffCon aframe)+++computeTcpDest :: (+  TcpStream ∈ rs+  , IpFields rs+  , TcpSrcPort ∈ rs+  , TcpDestPort ∈ rs+  ) => Record rs+  -> TcpConnection -> ConnectionRole+computeTcpDest x con  = if rgetField @IpSource x == conTcpClientIp con+                && rgetField @IpDest x == conTcpServerIp con+                && rgetField @TcpSrcPort x == conTcpClientPort con+                && rgetField @TcpDestPort x == conTcpServerPort con+                && rgetField @TcpDestPort x == conTcpServerPort con+                -- TODO should error if not the same streamId+                -- && (rgetField @TcpStream x) == (conTcpStreamId con)+        then RoleServer else RoleClient+++-- | TODO+-- See @addTcpDestToFrame@+addTcpDestinationsToAFrame :: (+  -- HostCols ⊆ rs,+  I.RecVec rs+  -- , HostCols <: rs+  -- , HostCols ∈ rs+  , IpFields rs+  , TcpFields rs)+  => FrameFiltered TcpConnection (Record rs)+  -> FrameFiltered TcpConnection (Record (TcpDest ': rs))+addTcpDestinationsToAFrame aframe =+  aframe { ffFrame = addDestinationsToFrame' (ffCon aframe)}+  where+    frame = ffFrame aframe+    addDestinationsToFrame' con = addTcpDestToFrame frame con++-- append a field with a value role+addTcpDestToRec :: (TcpStream ∈ rs, IpSource ∈ rs, IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs)+  => Record rs -> ConnectionRole ->  Record  ( TcpDest ': rs )+addTcpDestToRec x role = (Col role) :& x+++-- TODO take into account the different mptcp versions ?+genMptcpEndpointConfigFromRow :: Packet -> Maybe MptcpEndpointConfiguration+genMptcpEndpointConfigFromRow synAckPacket =+  case (synAckPacket ^. mptcpSendKey, synAckPacket ^. mptcpExpectedToken, synAckPacket ^. mptcpVersion) of +    (Just key, Just token, Just version) -> Just $ MptcpEndpointConfiguration key token version+    _ -> Nothing+    -- error $ "Could not find key/token/version " ++ show synAckPacket++-- retreiveMptcpServerTokenFromRow :: Packet -> Maybe (Word64, Word32)+-- retreiveMptcpServerTokenFromRow synAckPacket = +--   case (synAckPacket ^. mptcpSendKey, synAckPacket ^. mptcpExpectedToken) of +--     (Just key, Just token) -> Just (key, token)+--     _ -> error "Could not generate"++-- TODO++buildMptcpConnectionFromStreamId :: FrameRec HostCols+    -> StreamId Mptcp -> Either String (FrameFiltered MptcpConnection Packet)+buildMptcpConnectionFromStreamId frame streamId = do+    -- Right $ frameLength synPackets+    if frameLength streamPackets < 1 then+      Left $ "No packet with mptcp.stream == " ++ show streamId+    else if frameLength synAckPackets < 1 then+      Left $ "No syn/ack packet found for stream" ++ show streamId ++ " First packet: "+      -- ++ show streamPackets+    else if lefts subflows /= [] then+      Left $ concat (lefts subflows)+    else if mbServerConfig == Nothing then+      Left $ "Could not find MPTCP server config in " ++ show synAckPacket+    else++      case buildTcpConnectionFromStreamId streamPackets (synPacket ^. tcpStream) of+        Left err -> Left err+        Right aframe -> let+            clientFrame = filterFrame (\x -> ((not . isNothing) (x ^. mptcpSendKey))) (ffFrame aframe)+            mbClientConfig = genMptcpEndpointConfigFromRow (frameRow clientFrame 0)+          in+            if frameLength clientFrame == 0 then+              Left $ "Could not find mptcp client key"+            else+              -- TODO now add a check on abstime+              -- if ds.loc[server_id, "abstime"] < ds.loc[client_id, "abstime"]:+              --     log.error("Clocks are not synchronized correctly")+              -- update temporary fframe with the computed subflows+              Right $ FrameTcp {+                    ffCon = tempMptcpConn mbClientConfig+                  , ffFrame = streamPackets+                }+    where+      streamPackets :: FrameRec HostCols+      streamPackets = filterFrame  (\x -> x ^. mptcpStream == Just streamId) frame+      --+      -- |Just for the time+      tempMptcpConn clientConfig = MptcpConnection {+            mpconStreamId = streamId+          -- kinda risky, assumes we have the server key always+          , _mpconServerConfig = fromJust mbServerConfig+          , _mpconClientConfig = fromJust clientConfig+          -- , mptcpNegotiatedVersion = fromIntegral $ fromJust clientMptcpVersion :: Word8++          , _mpconSubflows = Set.fromList $ map ffCon (rights subflows)+        }+      -- suppose tcpflags is a list of flags, check if it is in the list+      -- of type FrameRec [(Symbol, *)]+      -- Looking for synack packets+      synPackets = filterFrame (\x -> TcpFlagSyn `elem` (x ^. tcpFlags)) streamPackets+      synAckPackets = filterFrame (\x -> TcpFlagSyn `elem` (x ^. tcpFlags) && TcpFlagAck `elem` (x ^. tcpFlags)) streamPackets+++      synPacket = frameRow synPackets 0+      synAckPacket = frameRow synAckPackets 0+      mbServerConfig = genMptcpEndpointConfigFromRow synAckPacket+      -- clientConfig :: Maybe MptcpEndpointConfiguration+      -- clientConfig = case mbServerConfig of+      --   Nothing -> Nothing+      --   Just serverConfig ->+      --     if mecVersion == 0 then genMptcpEndpointConfigFromRow synPacket+      --     else genMptcpEndpointConfigFromRow++      masterTcpstreamId = synPacket ^. tcpStream+      clientMptcpVersion = synPacket ^. mptcpVersion++      --+      subflows = map (buildSubflowFromTcpStreamId frame) (getTcpStreams streamPackets)+++-- filterFrame / buildFrameFromStreamId+{- Common interface to work with TCP and MPTCP connections+-}+class StreamConnection a b | a -> b where+  -- | How+  -- type ConnectionType :: Type+  showConnectionText :: a -> Text+  -- describeConnection :: a -> Text+  buildFrameFromStreamId :: Frame Packet -> StreamId b -> Either String (FrameFiltered a Packet)+  -- type Needs a :: Constraint++  -- type toto = Int++  -- | Compare two conection and give a similarityScore+  similarityScore :: a -> a -> Int+  -- listConnections :: FrameFiltered () [a]+  -- summarize :: a -> Text+  -- GetLabel ?+++-- | Compares 2 TCP connections and gives a score+-- The higher the score, the more similar the 2 connections are.+scoreTcpCon :: TcpConnection -> TcpConnection -> Int+scoreTcpCon con1 con2 =+  -- If every parameter is equal, returns +oo else 0+  -- TODO also match on isn in case ports got reused++  foldl (\acc toAdd -> acc + 10 * fromEnum toAdd) (0 :: Int) [+    conTcpClientIp con1 == conTcpClientIp con2+    , conTcpClientPort con1 == conTcpClientPort con2+    , conTcpServerIp con1 == conTcpServerIp con2+    , conTcpServerPort con1 == conTcpServerPort con2+  ]+++instance StreamConnection TcpConnection Tcp where+  showConnectionText = showTcpConnectionText+  buildFrameFromStreamId = buildTcpConnectionFromStreamId+  similarityScore = scoreTcpCon+++-- | Computes a score+scoreMptcpCon :: MptcpConnection -> MptcpConnection -> Int+scoreMptcpCon con1 con2 =+  let keyScore = if con1 ^. mpconServerConfig ^. mecKey == con2 ^. mpconServerConfig ^. mecKey+                    && con1 ^. mpconClientConfig ^. mecKey == con2 ^. mpconClientConfig ^. mecKey+      then 200+      else 0+  in+    keyScore+++instance StreamConnection MptcpConnection Mptcp where+  showConnectionText = showMptcpConnectionText+  buildFrameFromStreamId = buildMptcpConnectionFromStreamId+  similarityScore = scoreMptcpCon++instance StreamConnection MptcpSubflow Tcp where+  showConnectionText = showMptcpSubflowText+  buildFrameFromStreamId = buildSubflowFromTcpStreamId+  -- TODO use score as well+  similarityScore sf1 sf2 = similarityScore (sfConn sf1) (sfConn sf2)+++-- |Show the subflow (ids)+showMptcpSubflowText :: MptcpSubflow -> Text+showMptcpSubflowText sf =+  showConnectionText (sfConn sf) <> " (Local/Remote ids: " <> tshow (sfLocalId sf)+      <> "/" <> tshow (sfRemoteId sf) <> ", token " <> tshow (sfJoinToken sf) <> ")"++-- TODO add sthg in case it's the master subflow ?+showConnection :: StreamConnection a b => a -> String+showConnection = T.unpack . showConnectionText
+ src/MptcpAnalyzer/Plots.hs view
@@ -0,0 +1,21 @@+module MptcpAnalyzer.Plots+(+  -- module MptcpAnalyzer.Plots.Stream+)+where++import MptcpAnalyzer.Plots.Stream+import MptcpAnalyzer.Types+++-- connectionToLabel :: Connection -> String+-- connectionToLabel con@TcpConnection{} =+--   showIp (conTcpClientIp con) <> ":" <> tshow (conTcpClientPort con) <> " -> "+--       <> showIp (conTcpServerIp con) <> ":" <> tshow (conTcpServerPort con)+--       <> "  (tcp.stream: " <> tshow (conTcpStreamId con) <> ")"+--   where+--     showIp = Net.IP.encode++-- plotTcpSeq ::+--         plot (line ("TCP " ++ field ++ " (" ++ show dest ++ ")") [ [ (d,v) | (d,v) <- zip timeData seqData ] ])+
+ src/MptcpAnalyzer/Plots/Live.hs view
@@ -0,0 +1,199 @@+{-+Module:  MptcpAnalyzer.Commands.Plots.Live+Description :  Description+Maintainer  : matt+Portability : Linux+-}+module MptcpAnalyzer.Plots.Live+where++import qualified Data.Map as Map+import qualified Data.Text as T+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Plots.Types+import MptcpAnalyzer.Prelude+import MptcpAnalyzer.Utils.Text+import Net.Tcp+import qualified Polysemy.Embed as P+import qualified Polysemy.Log as Log+import System.Process hiding (runCommand)+import Tshark.Live+import Tshark.Main++import Polysemy (Final, Members, Sem, runFinal)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import qualified Polysemy.IO as P+import qualified Polysemy.Internal as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.Log.Colog (interpretLogStdout)+import qualified Polysemy.State as P+import Polysemy.Trace (trace)+import qualified Polysemy.Trace as P++-- import MptcpAnalyzer.Commands.Definitions as CMD+import Control.Monad.State (execStateT)+import Data.Maybe (fromMaybe, fromJust)+import GHC.IO.Handle+import Pipes (runEffect)+import System.Exit+import System.IO (stdout)+import Tshark.Fields+import Tshark.Capture+import Net.Mptcp.Connection+import Control.Lens ((^.))++configureLivePlotTcp :: Members '[Log, P.Trace, P.Embed IO] r+  => LivePlotTcpSettings+  -> Sem r LiveStatsTcp+configureLivePlotTcp (LivePlotTcpSettings connectionFilter mbFake mbConnectionRole ifname) = do+    let+      fields = Map.elems $ Map.map tfieldFullname baseFields++      -- stats/packetCount/Frame+      -- keeping it light for now+      destination = fromMaybe RoleServer mbConnectionRole+      lsConfig = LiveStatsConfig connectionFilter destination++      -- initialLiveStats :: LiveStatsTcp = LiveStats mempty 0 mempty+      toLoad = case mbFake of+        Just filename -> Right filename+        Nothing -> Left ifname++      --capture-comment+      tsharkPrefs = defaultTsharkPrefs {+        tsharkReadFilter = Just $ genReadFilterFromTcpConnection connectionFilter (Just destination)+        }+      (RawCommand bin genArgs) = generateCsvCommand fields toLoad tsharkPrefs+      -- args = genArgs ++ ["--capture-comment='Generated by mptcpanalyzer'"]+      args = genArgs ++ [ "-l"]+      createProc :: CreateProcess+      createProc = (proc bin args) {+            std_err = CreatePipe+            -- Inherit,+            , std_out = CreatePipe+            -- lets the child handle Ctrl-c+            , delegate_ctlc = True+          }++    Log.info $ "Looking at destination " <> tshow destination++    trace $ "Command run: " ++ show (RawCommand bin args)+    trace $ "Command run: " ++ showCommandForUser bin args+    -- Log.info $ "Starting " <> tshow bin <> tshow args+    ls <- P.embed $ startLivePlot lsConfig createProc+    pure ls++startLivePlot :: LiveStatsConfig -> CreateProcess -> IO LiveStatsTcp+startLivePlot lsConfig createProc = do+  let initialLiveStats :: LiveStatsTcp = LiveStats mempty mempty 0 mempty False++  (_, Just hout, Just herr, ph) <-  createProcess_ "error when creating process" createProc+  -- hSetBuffering stdout NoBuffering+  hSetBuffering stdout LineBuffering++  -- non blocking+  exitCode <- getProcessExitCode ph+  case exitCode of+    Just code -> putStrLn "Finished" >> pure initialLiveStats+    _ -> do+      -- hSetBuffering hout LineBuffering+      -- hSetBuffering herr NoBuffering+      putStrLn $ "Starting live TCP plot with initial stats: (before): " ++ show (lsPackets initialLiveStats)+      liveStats <- execStateT (runEffect (tsharkLoopTcp lsConfig hout)) initialLiveStats+      putStrLn $ "Live stats (after): " ++ show (lsPackets liveStats)+      -- putStrLn $ "Live stats (after): " ++ (T.unpack . showLiveStatsTcp) liveStats+      -- blocking+      putStrLn $ "Live stats (after): " ++ (T.unpack . showLiveStatsTcp) liveStats+      putStrLn $ "Waiting for process"+      exitCode2 <- waitForProcess ph+      case exitCode2 of+        ExitSuccess -> putStrLn "Success" >> pure liveStats+        _  -> do+          putStrLn "hGetContents"+          hGetContents herr >>= putStrLn >> pure initialLiveStats+  -- putStrLn $ "final exitCode"++-- LiveStatsMptcp+startMptcpCapture :: +-- Members '[Log, P.Trace, P.Embed IO] r =>+   LiveStatsConfig +   -> LiveStatsMptcp+   -> CreateProcess+   -> IO LiveStatsMptcp++startMptcpCapture lsConfig initialLiveStats createProc = do+  (_, Just hout, Just herr, ph) <- createProcess_ "error when creating process" createProc+  hSetBuffering stdout LineBuffering+  -- non blocking+  exitCode <- getProcessExitCode ph+  case exitCode of+    Just code -> putStrLn "Finished" >> pure initialLiveStats+    _ -> do+      -- hSetBuffering hout LineBuffering+      -- hSetBuffering herr NoBuffering+      putStrLn $ "Starting live mptcp plotting stats (before): "+      liveStats <- execStateT (runEffect (tsharkLoopMptcp lsConfig hout)) initialLiveStats+      case liveStats ^. lsmMaster of+        Nothing -> putStrLn "Could not detect the mptcp connection"+        Just master -> putStrLn $ "Live stats (after): " ++ (T.unpack $ showMptcpConnectionText master)+      -- putStrLn $ "Live stats (after): " ++ (T.unpack $ showMptcpConnectionText (fromJust $ liveStats ^. lsmMaster))+      putStrLn $ "Live stats (after): " ++ (T.unpack . showLiveStatsMptcp) liveStats+      -- putStrLn $ "Live stats (after): " ++ show (lsPackets liveStats)+      -- blocking+      exitCode2 <- waitForProcess ph+      case exitCode2 of+        ExitSuccess -> putStrLn "Success" >> pure liveStats+        _  -> do+          putStrLn "hGetContents"+          hGetContents herr >>= putStrLn >> pure liveStats+  -- putStrLn $ "final exitCode"++{- | Starts live analysis of an MPTCP flow+One needs to filter+-}+configureLivePlotMptcp :: Members '[Log, Cache, P.Trace, P.Embed IO] r =>+       LivePlotTcpSettings+    -- -> CaptureSettingsMptcp+    -> Sem r LiveStatsMptcp++configureLivePlotMptcp (LivePlotTcpSettings connectionFilter mbFake mbConnectionRole ifname) = do+    let+      destination = fromMaybe RoleServer mbConnectionRole++      lpConfig = LiveStatsConfig connectionFilter destination+      initialLiveStats = mkLiveStatsMptcp+      fields = Map.elems $ Map.map tfieldFullname baseFields++      -- stats/packetCount/Frame+      -- keeping it light for now+      toLoad = case mbFake of+        Just filename -> Right filename+        Nothing -> Left ifname++      --capture-comment+      tsharkPrefs = defaultTsharkPrefs {+        tsharkReadFilter = Just $ genReadFilterMptcpFromMptcpConnection+        }+      (RawCommand bin genArgs) = generateCsvCommand fields toLoad tsharkPrefs+      -- args = genArgs ++ ["--capture-comment='Generated by mptcpanalyzer'"]+      args = genArgs ++ [ "-l"]+      createProc :: CreateProcess+      createProc = (proc bin args) {+            std_err = CreatePipe+            -- Inherit,+            , std_out = CreatePipe+            -- lets the child handle Ctrl-c+            , delegate_ctlc = True+          }++    Log.info $ "Looking at destination " <> tshow destination++    trace $ "Command run: " ++ show (RawCommand bin args)+    trace $ "Command run: " ++ showCommandForUser bin args+    -- Log.info $ "Starting " <> tshow bin <> tshow args+    ls <- P.embed $ startMptcpCapture lpConfig initialLiveStats createProc+    pure ls+
+ src/MptcpAnalyzer/Plots/Stream.hs view
@@ -0,0 +1,39 @@+-- TODO make as plugin+module MptcpAnalyzer.Plots.Stream+where+++++-- import Diagrams.Backend.Rasterific+-- import Diagrams (dims2D, width, height)+-- import Frames+-- import Graphics.Rendering.Chart.Backend.Diagrams (defaultEnv, runBackendR)+-- import Graphics.Rendering.Chart.Easy++-- import Katip++-- where expect a parser+-- class Plot+--+-- mkPlot :: IO ()+-- mkPlot = do env <- defaultEnv bitmapAlignmentFns 640 480+--     let chart2diagram = fst . runBackendR env . toRenderable . execEC+--     xs <- runSafeT $ P.toListM fisherIncomeData+--     let d = chart2diagram $ do+--               layout_title .= "Farmer/fisher Income vs Age"+--               layout_x_axis . laxis_title .= "Age (Years)"+--               layout_y_axis . laxis_title .= "Capital Gain ($)"+--               plot (points "" (map (view age &&& view capitalGain) xs))+--         sz = dims2D (width d) (height d)+--     renderRasterific "plot2.png" sz d++-- Manually fused folds+-- main :: IO ()+-- main = do ((age_,inc,n), _) <- runSafeT $+--                                P.fold' aux (0,0,0::Double) id fisherIncomeData+--           putStrLn $ "The average farmer/fisher is "+++--                      show (fromIntegral age_ / n) +++--                      " and made " ++ show (fromIntegral inc / n)+--   where aux !(!sumAge, !sumIncome, n) f = (sumAge + f^.age, sumIncome + f^.capitalGain, n+1)+
+ src/MptcpAnalyzer/Plots/Types.hs view
@@ -0,0 +1,63 @@+{-+Module:  MptcpAnalyzer.Plots.Types+Description :+Maintainer  : matt+Portability : Linux++Trying to come up with a userspace abstraction for MPTCP path management++-}+module MptcpAnalyzer.Plots.Types (+  PlotSettings(..)+  , ArgsPlots(..)+  , LivePlotTcpSettings(..)+)+where++import Data.Word (Word32)+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import Net.IP+import Net.Tcp+import Net.Stream++-- | Settings shared by all plots+data PlotSettings = PlotSettings {+  -- | Where to save the file+  plsOut :: Maybe String+  -- | To override the default title+  , plsTitle :: Maybe String+  -- | Whether to display the result+  , plsDisplay :: Bool+  -- , ploLabelx :: String+  -- , ploLabely :: String+  , plsMptcp :: Bool -- ^ True if it's an mptcp plot (as opposed to TCP)+  }+      -- parser.add_argument('--display', action="store", default="term", choices=["term", "gui", "no"],++data LivePlotTcpSettings = LivePlotTcpSettings {+    lvsFilter :: TcpConnection   -- ^the connection to filter+  , lvsTestPcap :: (Maybe FilePath) -- ^a pcap file used to test, when set, ignore interface name+  , lvsDestination :: (Maybe ConnectionRole) -- % to filter destination+  , lvsIfName :: String -- ^Interface name+}++-- | The list of possible plots+data ArgsPlots =++    -- actually valid for MPTCP too+    -- | Expects a filename/streamId attr and maybe destination+    ArgsPlotTcpAttr+        FilePath -- ^ The pcap file to load+        Word32+        String   -- ^ The parameter to plot (e.g., "seq", "ack")+        (Maybe ConnectionRole)+    -- |+    -- @pcap1 pcap2 stream1 stream2 destinations whether its tcp or mptcp+    | ArgsPlotOwdTcp (PcapMapping Tcp) (Maybe ConnectionRole)+    | ArgsPlotOwdMptcp (PcapMapping Mptcp) (Maybe ConnectionRole)+    -- Maybe filename+    -- TODO use LivePlotTcpSettings instead ?+    | ArgsPlotLiveTcp LivePlotTcpSettings+    | ArgsPlotLiveMptcp LivePlotTcpSettings
+ src/MptcpAnalyzer/Prelude.hs view
@@ -0,0 +1,19 @@+module MptcpAnalyzer.Prelude (+  MptcpMembers+)+where++import Polysemy (Final, Members, Sem, runFinal)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import qualified Polysemy.IO as P+import qualified Polysemy.Internal as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.Log.Colog (interpretLogStdout)+import qualified Polysemy.State as P+import Polysemy.Trace (trace)+import qualified Polysemy.Trace as P++type MptcpMembers = '[Log, P.Trace, P.Embed IO]+
+ src/MptcpAnalyzer/Stats.hs view
@@ -0,0 +1,34 @@+{-|+Module      : MptcpAnalyzer.Stats+Description : Compute statistics on connections+Maintainer  : matt+License     : GPL-3+-}++module MptcpAnalyzer.Stats (+    -- getTcpStatsFromAFrame+  -- , getMptcpStats+  -- , getSubflowStats+  )+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Frame+import MptcpAnalyzer.Types+import Net.Mptcp+import Net.Tcp+import Tshark.Fields+++import Control.Lens hiding (argument)+import qualified Data.Foldable as F+import qualified Data.Map as Map+import Data.Ord (comparing)+import Data.Word (Word32, Word64)+import Frames+import qualified Frames as F+import qualified Frames.InCore as F+import MptcpAnalyzer.Pcap++-- TODO should be able to update an initial one+-- type Packet = Record HostCols
+ src/MptcpAnalyzer/Stream.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+module MptcpAnalyzer.Stream (+  readStreamId+  , module M+)+where+import Data.Hashable+import Data.Word (Word32)+import Options.Applicative++import Net.Stream as M++-- Phantom types+-- data Mptcp+-- data Tcp+-- data Protocol = Tcp | Mptcp+-- type TcpFlagList = [TcpFlag]++-- TODO use Word instead+-- newtype StreamId a = StreamId Word32 deriving (Show, Read, Eq, Ord ) deriving Hashable via Word32+-- type StreamIdTcp = StreamId Tcp+-- type StreamIdMptcp = StreamId Mptcp++-- showStream :: StreamId a -> Text+++-- |Can load stream ids from CSV files+readStreamId :: ReadM (StreamId a)+readStreamId = eitherReader $ \arg -> case reads arg of+  [(r, "")] -> return $ StreamId r+  _ -> Left $ "readStreamId: cannot parse value `" ++ arg ++ "`"
+ src/MptcpAnalyzer/Types.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module MptcpAnalyzer.Types+-- (+--   -- * types+--   PcapMapping(..)+--   , tcpDest+-- )+where++-- Inspired by Frames/demo/missingData+import MptcpAnalyzer.Stream+import Net.Stream+import Net.Bitset (fromBitMask, toBitMask, ToBitMask)+import Net.IP+import Net.IPv6 (IPv6(..))+import "mptcp-pm" Net.Tcp.Constants (TcpFlag(..))+import Tshark.Fields+import Tshark.TH++import Data.Hashable+import qualified Data.Hashable as Hash+import Data.Monoid (First(..))+import Data.Vinyl (ElField(..), Rec(..), rapply, rmapX, xrec)+import Data.Vinyl.Class.Method+import Data.Vinyl.Functor (Compose(..), (:.))+import qualified Data.Vinyl.TypeLevel as V++import qualified Data.Vinyl as V+import Data.WideWord.Word128+import Data.Word (Word16, Word32, Word64, Word8)+import Frames+import Frames.CSV (ParserOptions(..), QuotingMode(..))+import Frames.ShowCSV+import Frames.TH+-- (Parseable(..), parseIntish, Parsed(..))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Frames.ColumnTypeable+import Frames.InCore (VectorFor)+import Language.Haskell.TH+import Numeric (readHex)+import qualified Text.Read as T+-- import GHC.TypeLits+import Control.Lens+import Control.Monad (MonadPlus, liftM, mzero)+import qualified Data.Set as Set+import qualified Data.Text as TS+import qualified Data.Text.Lazy.Builder as B+import Data.Typeable (Typeable)+import qualified Frames as F+import GHC.Generics+import GHC.TypeLits (KnownSymbol)+import MptcpAnalyzer.ArtificialFields+import Options.Applicative+import System.Process (ProcessHandle)+++instance ToBitMask TcpFlag++{- Describe a TCP connection, possibly an Mptcp subflow+  The equality implementation ignores several fields+-}+-- data TcpConnection = TcpConnection {+--   -- TODO use libraries to deal with that ? filter from the command line for instance ?+--   srcIp :: IP -- ^Source ip+--   , dstIp :: IP -- ^Destination ip+--   , srcPort :: Word16  -- ^ Source port+--   , dstPort :: Word16  -- ^Destination port+--   , priority :: Maybe Word8 -- ^subflow priority+--   , localId :: Word8  -- ^ Convert to AddressFamily+--   , remoteId :: Word8+--   -- TODO remove could be deduced from srcIp / dstIp ?+--   , subflowInterface :: Maybe Word32 -- ^Interface of Maybe ? why a maybe ?+--   -- add TcpMetrics member+--   -- , tcpMetrics :: Maybe [SockDiagExtension]  -- ^Metrics retrieved from kernel++-- } deriving (Show, Generic, Ord)+++declarePrefixedColumns "" baseFields++-- when loading the second pcap to merge, we need to distinguish between the different fields+-- declarePrefixedColumns "test" baseFields+declarePrefixedColumns "" baseFieldsHost2+declarePrefixedColumns "" baseFieldsSender+declarePrefixedColumns "" baseFieldsReceiver++-- todo declare it from ArtificialFields ?+-- artificial types, i.e. created by the app and not tshark+declareColumn "tcpDest" ''ConnectionRole+-- | True if host 1 is sender+declareColumn "senderHost" ''Bool+declareColumn "senderDest" ''ConnectionRole+declareColumn "mptcpDest" ''ConnectionRole+declareColumn "packetHash" ''Int+declareColumn "colOwd" ''Double+++-- TODO check it generates+-- HostCols+genRecordFrom "HostCols" baseFields+-- these are useful when merging different+genRecordFromHeaders "" "HostColsPrefixed" baseFieldsHost2+-- genExplicitRecord "test" "HostColsPrefixed" baseFieldsHost2+genRecHashable "HashablePart" baseFields+genRecordFrom "SenderCols" baseFieldsSender+genRecordFrom "ReceiverCols" baseFieldsReceiver++-- | Represent a mapping between 2 pcaps captured at either end of a connection+-- (i.e., one pcap was captured at the client, the other at the receiver)+data PcapMapping a = PcapMapping {+      -- | Host 1 pcap to load+        pmapPcap1 :: FilePath+      , pmapStream1 :: StreamId a+      -- | Host 2+      , pmapPcap2 :: FilePath+      , pmapStream2 :: StreamId a+      -- , pmapVerbose :: Bool+      -- , pmapLimit :: Int -- ^Number of comparisons to show+      -- , pmapMptcp :: Bool -- ^Wether it's an MPTCP+    }+++-- row / ManRow+type Packet = Record HostCols+type PacketWithSenderDest = Record (SenderDest ': HostCols)+type PacketWithTcpDest = Record (TcpDest ': HostCols)+-- type PacketWithMptcpDest = Record (MptcpDest ': MptcpDest ': HostCols)++-- https://stackoverflow.com/questions/14020491/is-there-a-way-of-deriving-binary-instances-for-vinyl-record-types-using-derive?rq=1+-- forall t s a rs. (t ~ '(s,a)+-- comparable to Storable+deriving instance  (KnownSymbol s, Hashable a) => Hashable(ElField '(s, a))+deriving instance Hashable TcpFlag++-- | This is only here so we can use hash maps for the grouping step.  This should properly be in Vinyl itself.+instance Hashable (F.Record '[]) where+  hash = const 0+  {-# INLINABLE hash #-}+  hashWithSalt s = const s+  {-# INLINABLE hashWithSalt #-}++instance (V.KnownField t, Hashable (V.Snd t), Hashable (F.Record rs), rs F.⊆ (t ': rs)) => Hashable (F.Record (t ': rs)) where+  hashWithSalt s r = s `Hash.hashWithSalt` F.rgetField @t r `Hash.hashWithSalt` F.rcast @rs r+  {-# INLINABLE hashWithSalt #-}++deriving instance Hashable IP++-- IPv6 is Word128+deriving instance Generic IPv6++deriving instance Hashable Word128+deriving instance Hashable IPv6++-- shadow param+-- @a@ be Tcp / Mptcp+-- @b@ could be the direction+type PcapFrame a = Frame Packet+++-- | TODO adapt / rename to AFrame ? AdvancedFrames ?+-- GADT ?+data FrameFiltered a rs = FrameTcp {+    ffCon :: a+    -- StreamConnection b => b+    -- Frame of sthg maybe even bigger with TcpDest / MptcpDest+    , ffFrame :: Frame rs+  } deriving Functor+++aframeLength :: FrameFiltered a rs -> Int+aframeLength = frameLength . ffFrame+++-- Helper to pass information across functions+data MyState = MyState {+    _stateCacheFolder :: FilePath+  , _loadedFile   :: Maybe (FrameRec HostCols)  -- ^ cached loaded pcap+  , _prompt   :: String  -- ^ Prompt entry+  , _sharkdHandle   :: Maybe ProcessHandle -- ^ sharkd process handle+}++makeLenses ''MyState++++type OptionList = T.Text+++-- Used to parse tokens+instance (Read a, Typeable a, Frames.ColumnTypeable.Parseable a) => Frames.ColumnTypeable.Parseable (Maybe a) where+  parse txt = case T.null txt of+    True -> return $ Definitely Nothing+    False -> do+      val2 <- val+      return $ case val2 of+        Possibly x -> Possibly (Just x)+        Definitely x -> Definitely (Just x)+    where+      val :: MonadPlus m => m (Parsed a)+      val = parse txt++      -- val2 :: MonadPlus m => m (Parsed (Maybe a))+      -- val2 = Just <$> val+    -- case w64 of+    --   Left msg -> error $ "could not read " ++ show txt ++ ", error: " ++ msg+    --   Right val -> Definitely (Just val)+    -- where+    --     w64 = T.readEither (T.unpack txt)+++-- TODO parse based on ,+-- instance Frames.ColumnTypeable.Parseable (Maybe OptionList) where+--   parse _ = return $ Definitely Nothing++instance Frames.ColumnTypeable.Parseable Word16 where+  parse = parseIntish+instance Frames.ColumnTypeable.Parseable Word32 where+  parse = parseIntish++instance Frames.ColumnTypeable.Parseable Word64 where+  parse = parseIntish++instance Frames.ColumnTypeable.Parseable IP where+  -- parse :: MonadPlus m => T.Text -> m (Parsed a)+-- IP.decode :: Text -> Maybe IP+  -- fmap Definitely+  parse text = case decode text of+    Nothing -> return $ Possibly $ ipv4 0 0 0 0+    Just ip -> return $ Definitely ip++-- instance Frames.ColumnTypeable.Parseable Word64 where+--   parse = parseIntish++instance Readable (StreamId a) where+  fromText t = case T.readMaybe (T.unpack t) of+      Just streamId -> return $ StreamId streamId+      Nothing -> mzero+++instance Frames.ColumnTypeable.Parseable (StreamId Mptcp) where+  parse = parseIntish++instance Frames.ColumnTypeable.Parseable (StreamId Tcp) where+  parse = parseIntish+++--+parseList :: (MonadPlus m, Typeable a, Frames.ColumnTypeable.Parseable a) => Text -> m (Parsed [a])+parseList text = fmap Definitely (mapM parse' (T.splitOn "," text))++instance Frames.ColumnTypeable.Parseable [Word64] where+  -- expected type parse :: MonadPlus m => T.Text -> m (Parsed [a])+  parse = parseList+++-- could not parse 0x00000002+-- strip leading 0x+instance Frames.ColumnTypeable.Parseable [TcpFlag] where+  parse text = case readHex (T.unpack $ T.drop 2 text) of+    -- TODO generate+    [(n, "")] -> return $ Definitely $ fromBitMask n+    _ -> error $ "TcpFlags: could not parse " ++ T.unpack text++-- TODO rewrite it as wireshark exposes it, eg, in hexa ?+-- instance ShowCSV [TcpFlag] where+--   -- showCSV :: a -> Text+--   showCSV flagList = T.concat texts+--     where+--       texts = map (T.pack . show .fromEnum) flagList+--       res = toBitMask flagList++instance ShowCSV [TcpFlag] where+  -- showCSV :: a -> Text+  showCSV flagList = T.concat texts+    where+      texts = map (T.pack . show .fromEnum) flagList+      res = toBitMask flagList++instance ShowCSV [Word64] where+  -- showCSV :: a -> Text+  showCSV seqs = T.intercalate "," texts+    where+      texts = map (T.pack . show .fromEnum) seqs++instance ShowCSV IP where+  showCSV = encode++instance ShowCSV Word8 where+instance ShowCSV Word16 where+instance ShowCSV Word32 where+instance ShowCSV Word64 where+instance ShowCSV m => ShowCSV (Maybe m) where+  showCSV = \case+    Nothing -> ""+    Just x -> showCSV x++--+instance ShowCSV (StreamId a) where+  showCSV (StreamId stream) = showCSV stream+++-- type ManMaybe = Rec (Maybe :. ElField) ManColumns+-- TODO goal here is to choose the most performant Data.Vector+type instance VectorFor Word8  = V.Vector+type instance VectorFor Word16 = V.Vector+type instance VectorFor Word32 = V.Vector+type instance VectorFor Word64 = V.Vector+type instance VectorFor (Maybe Word8) = V.Vector+type instance VectorFor (Maybe Word16) = V.Vector+type instance VectorFor (Maybe Word32) = V.Vector+type instance VectorFor (Maybe Word64) = V.Vector+type instance VectorFor IP = V.Vector+type instance VectorFor TcpFlagList = V.Vector+type instance VectorFor (StreamId a) = V.Vector++type instance VectorFor (Maybe Int) = V.Vector+type instance VectorFor (Maybe Bool) = V.Vector+type instance VectorFor (Maybe OptionList) = V.Vector+type instance VectorFor MbMptcpStream = V.Vector+type instance VectorFor ConnectionRole = V.Vector+-- FIX generalize+type instance VectorFor [Word64] = V.Vector+type instance VectorFor (Maybe [Word64]) = V.Vector+++type TcpFields rs = (TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs)+type IpFields rs = (IpSource ∈ rs, IpDest ∈ rs)+
+ src/MptcpAnalyzer/Units.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveAnyClass #-}+{-+Module:  MptcpAnalyzer.Units+Description :  Make it easier to work with units+Maintainer  : matt+Portability : Linux++ecosystem around units is not great, and we have basic needs so let's reimplement some+basic code.+-}+module MptcpAnalyzer.Units (+  -- Types+  Bytes(..)+  , Timestamp (..)+  , Throughput(..)+  , Duration(..)++  -- functions+  , diffTime+  )+where+import Data.Word (Word32, Word64)++-- import Data.Time.Units+-- import Data.Time.Units++-- https://github.com/chrissound/byteunits#readme+data Bytes = Bytes Word64++data TimeUnit = Second | MilliSecond | NanoSecond+-- TimeUnit+-- TODO pass unit+data Timestamp  = Timestamp Double deriving (Show, Eq, Ord)+data Duration = Duration Double++instance Show Duration where+  -- for now we only measure seconds+  show (Duration d) = show d ++ "s"++-- (-) :: Timestamp -> Timestamp -> Duration+diffTime :: Timestamp -> Timestamp -> Duration+diffTime (Timestamp t1) (Timestamp t2) = Duration (t1 Prelude.- t2)++++data Throughput = Throughput Bytes Duration++instance Show Throughput where+  -- WIP+  show (Throughput (Bytes bytes) (Duration duration)) = show $ fromIntegral bytes / duration
+ src/MptcpAnalyzer/Utils/Completion.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE CPP #-}+{-|+Module: MptcpAnalyzer.Utils.Completion+Maintainer  : matt+License     : GPL-3+++  missingArgP :: ParseError -> Completer -> m a+  errorP :: ParseError -> m a++parseError peut renvoyer un missingArgP qui du coup aura le completer, qu'on n'a plus qu'a transcrire dans un completer haskeline !++-}+module MptcpAnalyzer.Utils.Completion (+  generateHaskelineCompleterFromParserInfo+  , completePath+  , readFilename+)+where++import Data.Char (isSpace)+import Data.List (isPrefixOf, isSuffixOf, stripPrefix)+import Data.Maybe (fromJust, fromMaybe, listToMaybe)+import Debug.Trace+import Options.Applicative+import Options.Applicative.Common+import Options.Applicative.Help (Doc, renderPretty)+import Options.Applicative.Help.Chunk+import Options.Applicative.Help.Pretty (displayS)+import Options.Applicative.Internal hiding (Completion)+import Options.Applicative.Types hiding (replacement)+import System.Console.Haskeline+       (Completion(..), CompletionFunc, completeFilename, noCompletion)+import System.Console.Haskeline.Completion (listFiles)+-- import Options.Applicative.Help (parserHelp)+import System.IO.Unsafe (unsafePerformIO)+import System.Posix (fileExist, getFileStatus, isRegularFile)++defaultCompleteFunc :: CompletionFunc IO+defaultCompleteFunc = completeFilename+++-- | We use unsafePerformIO to work around optparse-applicative limitation+readFilename :: String -> Either String FilePath+readFilename path =+  -- fileExist seems to consider files and folders alike+  let exists = unsafePerformIO $ do+        t <- fileExist path+        if t then+          getFileStatus path >>= return . isRegularFile+        else+          return False+  in+  case exists of+    True ->+#ifdef DEBUG_COMPLETION+      trace "right path"+#endif+      Right path+    False ->+#ifdef DEBUG_COMPLETION+      trace ("path " ++ path ++ " DOES NOT EXIST (returning Left)")+#endif+      Left "Path does not exist"++-- optparse2haskelineCompletion+oa2hl :: CompletionItem -> Completion+oa2hl (CompletionItem replacement' display' isFinished') =+  Completion replacement' display' isFinished'++hl2oa :: Completion -> CompletionItem+hl2oa (Completion replacement' display' isFinished') =+  CompletionItem replacement' display' isFinished'++-- newtype Completer = Completer+--   { runCompleter :: String -> IO [String] }+-- type CompletionFunc m = (String, String) -> m (String, [Completion])+-- "optparse-applicative" wrapper around haskelinec>s 'completeFilename'+-- The first 'String' argument is the contents of the line to the left of the cursor,+-- reversed.+-- The second 'String' argument is the contents of the line to the right of the cursor.+-- TODO this should accept a filter ? like for which type of file+completePath :: Completer+completePath = mkCompleter $ \entry -> do+  -- case words entry of+  --   [] -> ""+  --   x -> tail+  (_, completions) <-+#ifdef DEBUG_COMPLETION+    trace "completeFilename called with entry"+#endif+    completeFilename (reverse entry, "")+  let completions' = map hl2oa completions+  putStrLn $ "completePath called !! with entry: [" ++ entry ++ "]"+  return $+#ifdef DEBUG_COMPLETION+    trace ("completions: " ++ show completions)+#endif+    completions'++-- drop 1 was for progname ?+-- TODO make it so that it returns [Completion] instead+-- runParser and runParserStep+haskelineCompletionQuery :: ParserInfo a -> ParserPrefs+  -> [String]+  -- ^ words , Should be Args ?+  -- -> Int+  -- ^ current word (to remove ?)+  -> String -> IO [Completion]+haskelineCompletionQuery pinfo pprefs ws rest = case runCompletion compl pprefs of+  Just (Left (SomeParser p, a)) ->+#ifdef DEBUG_COMPLETION+    trace "listing options\n"+#endif+    list_options a p+  -- terminal case+  Just (Right c) ->+#ifdef DEBUG_COMPLETION+    trace "terminal completer\n"+#endif+    run_completer c+  Nothing ->+#ifdef DEBUG_COMPLETION+    trace "runCompletion into Nothing\n"+#endif+    return []+  where+    --current word+    -- runParserInfo te renvoie une (Completion a)+    -- drop 1 looks necesary here ?+    compl =+#ifdef DEBUG_COMPLETION+      traceShow ("Passing args " ++ show ws ++ "\n")+#endif+      runParserInfo pinfo ws+    -- runParserInfo calls runParserFully+    -- compl = runParserInfo pinfo ws+    -- trace ("runCompleter: ws=" ++ show ws ++ " i=" ++ show i ++ "ws''= " ++ show ws'' ++ " rest=" ++ show rest)++    list_options a+      = fmap concat+      . sequence+      . mapParser (opt_completions a)++    -- Prior to 0.14 there was a subtle bug which would+    -- mean that completions from positional arguments+    -- further into the parse would be shown.+    --+    -- We therefore now check to see that+    -- hinfoUnreachableArgs is off before running the+    -- completion for position arguments.+    --+    -- For options and flags, ensure that the user+    -- hasn't disabled them with `--`.+    -- opt_completions :: ArgPolicy -> ArgumentReachability -> Option a -> m [Completion]+    -- trace ("argPolicy " ++ show argPolicy ++ "\n")+    opt_completions argPolicy reachability opt = case  optMain opt of+      OptReader ns _ _+         | argPolicy /= AllPositionals ->+#ifdef DEBUG_COMPLETION+            trace "unreachable OptReader\n"+#endif+            return . add_opt_help opt $ show_names ns+         -- trace "optreader\n"+         | otherwise ->  return []+      FlagReader ns _+         | argPolicy /= AllPositionals ->+#ifdef DEBUG_COMPLETION+            trace "unreachableflag reader\n"+#endif+            return . add_opt_help opt $ show_names ns+         -- trace "flagreader\n"+         | otherwise ->  return []+      ArgReader rdr+         | argumentIsUnreachable reachability -> +#ifdef DEBUG_COMPLETION+            trace "unreachable\n " +#endif+            return []+         -- TODO restore arg Reader with file autocomplete+         --  | otherwise -> return []+         -- trace "argreader\n"+         | otherwise -> run_completer (crCompleter rdr)+         -- >>= \x -> return $ Completion x "argreader help" True+      CmdReader _ ns p+         | argumentIsUnreachable reachability ->+#ifdef DEBUG_COMPLETION+              trace "unreachable cmdreader\n" +#endif++              return []+         -- trace "cmdreader\n"+         | otherwise -> return . add_cmd_help p $ filter_names ns++    -- When doing enriched completions, add any help specified+    -- to the completion variables (tab separated).+    add_opt_help :: Functor f => Option a -> f String -> f Completion+    add_opt_help opt = fmap $ \o ->+          let h = unChunk $ optHelp opt+              len = 80+          in  maybe (Completion o "option help" True) (\h' -> Completion o (o ++ "\t" ++ render_line len h' ) False) h++    -- When doing enriched completions, add the command description+    -- to the completion variables (tab separated).+    add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f Completion+    add_cmd_help p = fmap $ \cmd -> let+            len = 80+            h = p cmd >>= unChunk . infoProgDesc+          in+            -- if there is a parser info we add help+            maybe (Completion cmd "cmd help" True) (\h' -> Completion cmd (cmd ++ "\t" ++ render_line len h') False) h++    show_names :: [OptName] -> [String]+    show_names = filter_names . map showOption++    -- We only want to show a single line in the completion results description.+    -- If there was a line break, it would come across as a different completion+    -- possibility.+    render_line :: Int -> Doc -> String+    render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of+      [] -> ""+      [x] -> x+      x : _ -> x ++ "..."++    filter_names :: [String] -> [String]+    filter_names = filter (isPrefixOf currentArg)++    -- TODO fix the arg+    run_completer :: Completer -> IO [Completion]+    -- (fromMaybe "" (listToMaybe [currentArg]))+    run_completer c =++#ifdef DEBUG_COMPLETION+      trace ("running completer against " ++ currentArg)+#endif+      runCompleter c currentArg >>= return . map oa2hl++    currentArg :: String+    currentArg = case ws of+      [] -> ""+      ws' -> last ws'++-- The output String is the unused portion of the left half of the line, reversed.+-- type CompletionFunc m = (String, String) -> m (String, [Completion]+-- haskeline System.Console.Haskeline.Completion+-- Performs completions from the given line state. The first String argument is the+--  contents of the line to the left of the cursor, reversed. The second String+-- argument is the contents of the line to the right of the cursor. The output+--  String is the unused portion of the left half of the line, reversed+generateHaskelineCompleterFromParserInfo :: ParserPrefs -> ParserInfo a -> CompletionFunc IO+generateHaskelineCompleterFromParserInfo parserPrefs pinfo =+  \(rleft, right) ->+  let+    leftArgs = words $ reverse rleft+    fullArgs = reverse rleft ++ right+    fullArgs' = words fullArgs ++ if trailingSpace then [""] else []+    currentWord = last leftArgs+    parserResult =+#ifdef DEBUG_COMPLETION +        trace ("\nParsing args " ++ reverse rleft ++ "\n")+#endif++        execParserPure parserPrefs pinfo leftArgs+    trailingSpace = " " `isSuffixOf` fullArgs+    leftRes = case fullArgs' of+      [] -> ""+      _ -> mconcat (init fullArgs') ++ if trailingSpace then " " else ""+  in do+    candidates <- haskelineCompletionQuery pinfo parserPrefs (trace ("\n" ++ show fullArgs' ++ "\n" ) fullArgs') ""+    -- putStrLn $ "Returned candidates : " ++ show candidates++    -- now onto converting candidates+    -- TODO stripper le commonPrefix+    -- map (\x -> System.Console.Haskeline.Completion x x False)+++    pure (" " ++ reverse leftRes,  map (+      id+      -- \x -> x { replacement = fromMaybe "error" (stripPrefix currentWord (display x)) }+      )+      candidates)+++-- runParserInfo on a subparser only goes one level deep+-- so we need to run it twice+-- customHaskelineParser :: ParserInfo a -> ParserPrefs -> CompletionFunc IO+-- customHaskelineParser pinfo pprefs =+--   \(rleft, right) ->+--   let+--     leftArgs = words $ reverse rleft+--     -- TODO rename to str+--     fullArgs = reverse rleft ++ right+--     fullArgs' = words fullArgs ++ if trailingSpace then [""] else []+--   in do+--     if len fullArgs' > 1 then+--       generateHaskelineCompleterFromParserInfo (++-- generateHaskelineCompleterFromParserInfo = haskelineCompletionQuery+-- generateHaskelineCompleterFromParser pprefs (infoParser pinfo)++-- generateHaskelineCompleterFromParser :: ParserPrefs -> Parser a -> CompletionFunc IO+-- generateHaskelineCompleterFromParser parserPrefs (OptP opt) = generateHaskelineCompleterFromOption opt+-- generateHaskelineCompleterFromParser _ _ = error "undefined "++-- argument completeWith / complete+placeholderCompletion :: System.Console.Haskeline.Completion+placeholderCompletion = Completion "itworked" "display" False++constCompletionFunc :: CompletionFunc IO+constCompletionFunc (left, right) = pure ("worked", [placeholderCompletion])++-- generateHaskelineCompleterFromOption :: Option a -> CompletionFunc IO+-- generateHaskelineCompleterFromOption (Option main _properties) = generateHaskelineCompleterFromOptreader main++-- generateHaskelineCompleterFromOptreader :: OptReader a -> CompletionFunc IO+-- generateHaskelineCompleterFromOptreader (CmdReader mbGrpCommand arrStr func) =+--   \(rleft, right) -> let+--     filtered = filter (isPrefixOf prefix) arrStr+--     -- genCompletions :: String -> IO [Completion]+--     -- genCompletions prefix = map (genCompletion prefix)+--     -- "TODO show help for " +++--     genCompletion entry =  Completion entry ( entry) True+--     prefix = reverse rleft+--     longestCommonPrefix entries = rleft+--     completions = map (genCompletion) filtered+--   in+--     -- TODO call execParserPure ParserInfo a+--     trace "completion called" (pure (+--     -- return longest common prefixes+--     "", completions+--     ))++-- -- TODO convert the C+-- -- generateHaskelineCompleterFromOptreader (ArgReader (CReader completer _)) =+-- generateHaskelineCompleterFromOptreader _ = error "undefined generateHaskelineCompleterFromOptreader"
+ src/MptcpAnalyzer/Utils/Text.hs view
@@ -0,0 +1,12 @@+module MptcpAnalyzer.Utils.Text (+  -- completeInitialCommand+  -- generateHaskelineCompleterFromParser+  tshow+)+where++import qualified Data.Text as TS++tshow :: Show a => a -> TS.Text+tshow = TS.pack . Prelude.show+
+ src/Net/Mptcp/Stats.hs view
@@ -0,0 +1,204 @@+{-|+Module      : Net.Mptcp.Stats+Description : Compute basic MPTCP statistics+Maintainer  : matt+License     : GPL-3+-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE StandaloneDeriving #-}+module Net.Mptcp.Stats (+    TcpSubflowUnidirectionalStats(..)+  , MptcpUnidirectionalStats(..)+  , getMptcpStats+  , getMptcpGoodput+  , getMptcpStatsDuration+  , getSubflowStats+  , showMptcpUnidirectionalStats+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Units++import qualified Data.Map as Map+import Net.Mptcp.Connection+import Net.Tcp+import Net.Tcp.Stats++import Data.Either (fromRight)+import Data.Text (Text)+import qualified Data.Text as T++import Control.Lens+import Control.Lens hiding (argument)+import Data.List (sort, sortBy, sortOn)+import Data.Map (Map, fromList, mapKeys)+import qualified Data.Map as Map+import Data.Maybe (catMaybes, fromJust)+import Data.Set (toList)+import Data.Vinyl+import Data.Word (Word32, Word64)+import qualified Data.Foldable as F+import qualified Frames as F+import qualified Frames.InCore as F+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Control.Exception (assert)+-- import MptcpAnalyzer.Pcap (addTcpDestinationsToAFrame)++-- | Useful to show DSN+data TcpSubflowUnidirectionalStats = TcpSubflowUnidirectionalStats {+  -- tssStats :: TcpUnidirectionalStats+    tssStats  :: TcpUnidirectionalStats+  , tssMinDsn :: Word64+  , tssMaxDsn :: Word64+  } deriving Show+-- newtype TcpSubflowUnidirectionalStats = TcpSubflowUnidirectionalStats++instance Semigroup TcpSubflowUnidirectionalStats where+   -- (<>) :: a -> a -> a+   -- TODO this does nothing+   (<>) a b = a++instance Monoid TcpSubflowUnidirectionalStats where+  mempty = TcpSubflowUnidirectionalStats {+      tssStats = mempty +    , tssMinDsn = 0+    , tssMaxDsn = 0+    }+++-- | Holds MPTCP application level statistics for one direction+data MptcpUnidirectionalStats = MptcpUnidirectionalStats {+    musDirection        :: ConnectionRole+  , musApplicativeBytes :: Word64+  , musMaxDsn           :: Word64+  , musMinDsn           :: Word64+  , musSubflowStats     :: Map MptcpSubflow TcpSubflowUnidirectionalStats+  } deriving Show++instance Monoid MptcpUnidirectionalStats where+  mempty = MptcpUnidirectionalStats RoleServer 0 0 0 mempty++instance Semigroup MptcpUnidirectionalStats where+  -- TODO fix+  (<>) s1 s2 = assert (musDirection s1 == musDirection s2)+      s1 {+            musMaxDsn = max (musMaxDsn s1) (musMaxDsn s2)+          , musMinDsn = min (musMinDsn s1) (musMinDsn s2)+          -- , musApplicativeBytes = musApplicativeBytes s1 ++ musApplicativeBytes s2+        }+++    -- ''' application data = goodput = useful bytes '''+    -- ''' max(dsn)- min(dsn) - 1'''+    -- mptcp_application_bytes: Byte++    -- '''Total duration of the mptcp connection'''+    -- mptcp_duration: datetime.timedelta+    -- subflow_stats: List[TcpUnidirectionalStats]++    -- @property+    -- def mptcp_throughput_bytes(self) -> Byte:+    --     ''' sum of total bytes transferred '''+    --     return Byte(sum(map(lambda x: x.throughput_bytes, self.subflow_stats)))++-- |Goodput is defined as the amount of effective data exchanged over time+-- I.e., (maxDsn - minDsn) / (Mptcp communication Duration)+getMptcpGoodput :: MptcpUnidirectionalStats -> Throughput+getMptcpGoodput s = Throughput (Bytes $ musApplicativeBytes s) ((getMptcpStatsDuration s) ^. _1)++-- fromIntegral++-- | return max - min across subflows+getMptcpStatsDuration :: MptcpUnidirectionalStats -> (Duration, Timestamp, Timestamp)+getMptcpStatsDuration s = (diffTime end start, start, end)+  where+    start = Timestamp $ head $ sort starts+    end = Timestamp $ last $ sort ends+    -- min of+    -- TODO get min+    starts = map (tusStartTime . tssStats) (Map.elems $ musSubflowStats s)+    -- take the maximum+    ends = map (tusEndTime . tssStats) (Map.elems $ musSubflowStats s)+++-- | TcpSubflowUnidirectionalStats+getSubflowStats ::+  (TcpSeq F.∈ rs, F.RecVec rs, RelTime F.∈ rs, TcpLen F.∈ rs+  , PacketId F.∈ rs+    , IpSource ∈ rs, IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs+  -- , TcpDest F.∈ rs+  )+  => FrameFiltered MptcpSubflow (F.Record rs) -> ConnectionRole -> TcpSubflowUnidirectionalStats+getSubflowStats aframe role = TcpSubflowUnidirectionalStats {+      tssStats = getTcpStatsFromAFrame (addTcpDestinationsToAFrame aframe') role+      , tssMinDsn = 0+      , tssMaxDsn = 0+    }+    where+      aframe' = FrameTcp (sfConn $ ffCon aframe) (ffFrame aframe)+++-- mptcp_compute_throughput est bourrin il calcule tout d'un coup, je veux avoir une version qui marche iterativement+-- | Generates Stats for one direction only+getMptcpStats ::+  (+   -- TcpDest F.∈ rs+  MptcpDsn F.∈ rs, TcpSeq F.∈ rs, IpDest F.∈ rs, IpSource F.∈ rs+  , TcpLen F.∈ rs+  , PacketId F.∈ rs+  , TcpDestPort F.∈ rs, MptcpRecvToken F.∈ rs+  , TcpFlags F.∈ rs, TcpSrcPort F.∈ rs, TcpStream F.∈ rs, RelTime F.∈ rs+  , rs F.⊆ HostCols+  , F.RecVec rs+  )+  => FrameFiltered MptcpConnection (F.Record rs)+  -> ConnectionRole+  -> MptcpUnidirectionalStats+getMptcpStats (FrameTcp mptcpConn frame) dest =+  MptcpUnidirectionalStats {+      musDirection = dest+    , musApplicativeBytes = getSeqRange maxDsn minDsn+    , musMaxDsn = maxDsn+    , musMinDsn = minDsn+    -- we need the stream id / FrameFiltered MptcpSubflow (Record rs)+    , musSubflowStats = Map.fromList $ map (\sf -> (sf, getStats dest sf))  (toList $ _mpconSubflows mptcpConn)+  }+  where+    -- buildTcpConnectionFromStreamId :: SomeFrame -> StreamId Tcp -> Either String (FrameFiltered TcpConnection Packet)+    -- traverse a set+    getStats role sf = let+        sfFrame = fromRight (error "could not build sfFrame") (buildSubflowFromTcpStreamId frame (conTcpStreamId $ sfConn sf))+        -- sfFrame' = addTcpDestinationsToAFrame sfFrame+      in+        getSubflowStats sfFrame role++    -- frame = addTcpDestToFrame $ ffFrame aframe+    -- these return Maybes+    -- minSeq = minimum (F.toList $ view tcpSeq <$> frame)+    -- maxSeq = maximum $ F.toList $ view tcpSeq <$> frame++    maxTime = maximum $ F.toList $ view relTime <$> frame+    minTime = minimum $ F.toList $ view relTime <$> frame++    -- dsn_range, dsn_max, dsn_min = transmitted_seq_range(df, "dsn")+    -- mbRecs = map recMaybe mergedRes+    -- justRecs = catMaybes mbRecs+  -- in+    -- (toFrame justRecs, [])++    dsns = catMaybes $ F.toList $ view mptcpDsn <$> frame++    -- mergedPcapToFrame+    maxDsn, minDsn :: Word64+    maxDsn = maximum dsns++    minDsn = minimum dsns++showMptcpUnidirectionalStats :: MptcpUnidirectionalStats -> Text+showMptcpUnidirectionalStats stats = T.unlines [+  "Max/min dsn: " <> tshow (musMinDsn stats) <> "/" <> tshow (musMaxDsn stats) <> " towards " <> tshow (musDirection stats)+  ]
+ src/Net/Tcp/Stats.hs view
@@ -0,0 +1,323 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-}+{-+Module:  Net.Tcp.Stats+Description : Compute basic TCP statistics+Maintainer  : matt+Portability : Linux+-}++module Net.Tcp.Stats (+  TcpUnidirectionalStats (..)+  , getTcpGoodput+  , getTcpThroughput+  , getTcpSeqRange+  , getTcpStatsFromAFrame+  , getSeqRange+  , showTcpUnidirectionalStats+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Types+import MptcpAnalyzer.Utils.Text+import Net.Tcp.Connection++import qualified Control.Foldl as L+import Control.Lens hiding (argument)+import qualified Data.Map as Map+import Data.Maybe (fromJust)+import Data.Word (Word32, Word64)+-- import Data.ByteUnits++import qualified Data.Foldable as F+import Data.Ord (comparing)+import qualified Data.Text as T+import Frames+import qualified Frames as F+import qualified Frames.InCore as F++type Byte = Int++-- tus = tcp Unidrectional Stats+data TcpUnidirectionalStats = TcpUnidirectionalStats {+    -- sum of tcplen / should be the same for tcp/mptcp+    -- Include redundant packets contrary to '''+    -- tusThroughput :: Byte++    -- tusStartPacketId :: Word64+    -- , tusEndPacketId :: Word64+    tusNrPackets :: Int+    -- duration+    -- , tusDuration :: Double++    -- TODO convert to date ?+    , tusStartTime :: Double+    , tusEndTime :: Double++    -- For now = max(tcpseq) - minx(tcpseq). Should add the size of packets'''+    -- , tusMinSeq :: Word32+    -- , tusMaxSeq :: Word32++    -- transferred bytes+    -- , tusCumulativeBytes :: Map Word64 Word16+    , tusMinSeq :: Word32+    , tusSndUna :: Word32+    , tusSndNext :: Word32+    -- , tusReinjectedBytes :: Map Word64 Word16+    , tusReinjectedBytes :: Word32 -- ^Amount of reinjected bytes+    -- , tusUniqueBytes :: Word64++    -- , tusMinAck :: Word32+    -- , tusMaxAck :: Word32++    -- application data = goodput = useful bytes '''+    -- TODO move to its own ? / Maybe+    -- , mptcp_application_bytes :: Byte+    -- , tusThroughputContribution :: Double+    -- , tusGoodputContribution :: Double++    -- TODO this should be updated+    -- For now = max(tcpseq) - minx(tcpseq). Should add the size of packets'''+    -- , tusGoodput :: Byte+    }  deriving (Show, Eq)+    -- deriving Semigroup via WrappedMonoid TcpUnidirectionalStats++-- deriving instance Semigroup TcpUnidirectionalStats+-- deriving instance Monoid TcpUnidirectionalStats++instance Semigroup TcpUnidirectionalStats where+   -- (<>) :: a -> a -> a+   -- TODO this does nothing+   (<>) a b = TcpUnidirectionalStats {+      -- tusThroughput = 0+      -- tusStartPacketId = min (tusStartPacketId a) (tusStartPacketId b)+      -- , tusEndPacketId = max (tusEndPacketId a) (tusEndPacketId b)+      tusNrPackets = tusNrPackets a + tusNrPackets b+      , tusStartTime = min (tusStartTime a) (tusStartTime b)+      , tusEndTime = max (tusEndTime a) (tusEndTime b)+      -- let it to 0 for now+      , tusMinSeq = 0++      -- TODO should be max of seen acks+      , tusSndUna = max (tusSndUna a) (tusSndUna b)+      , tusSndNext = max (tusSndNext a) (tusSndNext b)+      , tusReinjectedBytes = 0+      -- , tusSnd = 0+      -- , tusNumberOfPackets = mempty+    }++instance Monoid TcpUnidirectionalStats where+  mempty = TcpUnidirectionalStats {+      -- tusThroughput = 0+      -- tusStartPacketId = 0 -- (frameRow frame 0) ^. packetId+      -- , tusEndPacketId = 0 -- (frameRow frame (frameLength frame - 1)) ^. packetId+      tusNrPackets = 0+      , tusStartTime = 0+      , tusEndTime = 0+      , tusMinSeq = 0        -- TODO fill it++      -- TODO should be max of seen acks+      , tusSndUna = 0+      , tusSndNext = 0+      , tusReinjectedBytes = 0+      -- , tusSnd = 0+      -- , tusNumberOfPackets = mempty+    }++-- | TODO check boundaries etc+getSeqRange :: Num a => a -> a+  -> a+  -- -> (a, a, a)+-- getSeqRange maxSeq minSeq = (maxSeq - minSeq + 1, maxSeq, minSeq)+getSeqRange maxSeq minSeq = maxSeq - minSeq + 1++++-- TODO add a Functor to FilteredFrame+genTcpStats :: Frame Packet -> TcpUnidirectionalStats+genTcpStats aframe = TcpUnidirectionalStats {++    -- TODO we should run a minmax instead+    -- tusStartPacketId = minPktId+    -- , tusEndPacketId = maxPktId+    tusNrPackets = frameLength aframe+    --     maxTime = maximum $ F.toList $ view relTime <$> frame+    -- minTime = minimum $ F.toList $ view relTime <$> frame++    -- We could just take first and last+    , tusStartTime = minTime+    , tusEndTime = maxTime++    , tusMinSeq = 0 -- not used+    , tusSndUna = maxUna+    , tusSndNext = 0+    , tusReinjectedBytes = 0+  }+  where+    -- we could use the Statistics vector if we could use the+    (minPktId, maxPktId) = case L.fold ((,) <$> L.minimum <*> L.maximum) $ F.toList $ view packetId <$> aframe of+        (Just pmin, Just pmax) -> (pmin, pmax)+        _otherwise -> error "Could not find either min or max"++    (minTime, maxTime) = case L.fold ((,) <$> L.minimum <*> L.maximum) $ F.toList $ view relTime <$> aframe of+        (Just pmin, Just pmax) -> (pmin, pmax)+        _otherwise -> error "Could not find either min or max"++    (minSeq, maxSeq) = case L.fold ((,) <$> L.minimum <*> L.maximum) $ F.toList $ view tcpSeq <$> aframe of+        (Just pmin, Just pmax) -> (pmin, pmax)+        _otherwise -> error "Could not find either min or max"++    -- TODO+    (minUna, maxUna) = case L.fold ((,) <$> L.minimum <*> L.maximum) $ F.toList $ view tcpAck <$> aframe of+        (Just pmin, Just pmax) -> (pmin, pmax)+        _otherwise -> error "Could not find either min or max"++++-- | Destination should have been filtered upstream+-- see @genTcpDestFrame@+-- TODO suffix fromFrame+getTcpStatsFromAFrame :: (+  TcpSeq F.∈ rs+  , F.RecVec rs+  , TcpLen F.∈ rs, RelTime F.∈ rs+  , PacketId F.∈ rs+  -- disabled for now, we assumed it's filtered upstream+  , TcpDest F.∈ rs+  )+  => FrameFiltered TcpConnection (F.Record rs)+  -> ConnectionRole+  -> TcpUnidirectionalStats+getTcpStatsFromAFrame aframe dest =+  if frameLength frame == 0 then+    mempty+  else+    TcpUnidirectionalStats {+      -- tusThroughput = 0+      -- tusStartPacketId = 0 -- (frameRow frame 0) ^. packetId+      -- , tusEndPacketId = 0 -- (frameRow frame (frameLength frame - 1)) ^. packetId+      tusNrPackets = frameLength frame+      , tusStartTime = minTime+      , tusEndTime = maxTime+      -- TODO fill it+      , tusMinSeq = minSeq++      -- TODO should be max of seen acks+      , tusSndUna = maxSeqRow ^. tcpSeq + fromIntegral ( maxSeqRow ^. tcpLen) :: Word32+      , tusSndNext = maxSeqRow ^. tcpSeq + fromIntegral ( maxSeqRow ^. tcpLen ) :: Word32+      , tusReinjectedBytes = 0+    }+  where+    frame = F.filterFrame (\x -> x ^. tcpDest == dest) (ffFrame aframe)++    -- these return Maybes+    -- I need to find its id and add tcpSize afterwards+    -- TODO use     minimumBy+    minSeq = case F.toList $ view tcpSeq <$> frame of+      [] -> 0+      l -> minimum l+    -- maxSeq = maximum $ F.toList $ view tcpSeq <$> frame++    -- $ F.toList $ view tcpSeq <$> frame+    maxSeqRow = F.maximumBy (comparing (^. tcpSeq)) frame++    -- compareRows x y = if (x ^. tcpSeq) (y ^. tcpSeq)++    maxTime = maximum $ F.toList $ view relTime <$> frame+    minTime = minimum $ F.toList $ view relTime <$> frame+++-- byteValue+getTcpSeqRange :: TcpUnidirectionalStats -> Double+getTcpSeqRange s =+  fromIntegral (tusSndUna s - tusMinSeq s - 1)++-- | Computes throughput+-- TODO should return a quantity with number+getTcpThroughput :: TcpUnidirectionalStats -> Double+getTcpThroughput s =+  if tusNrPackets s == 0 then 0+  else fromIntegral (tusSndUna s - tusMinSeq s - 1) / (tusEndTime s - tusStartTime s)++-- | Computes goodput+getTcpGoodput :: TcpUnidirectionalStats -> Double+getTcpGoodput s =+  fromIntegral (tusSndUna s - tusMinSeq s + 1 - tusReinjectedBytes s) / (tusEndTime s - tusStartTime s)++showTcpUnidirectionalStats :: TcpUnidirectionalStats -> Text+showTcpUnidirectionalStats stats =+  T.unlines [+    "Timestamps:" <> tshow (tusStartTime stats) <> " -> " <> tshow (tusEndTime stats)+    , "Reinjected bytes: " <> tshow (tusReinjectedBytes stats)+    , "Current goodput: " <> tshow (getTcpGoodput stats)+  ]++    -- duration = maxTime - minTime++++-- No instance for (Ord (Frames.Frame.Frame GHC.Word.Word32))+-- instance Ord a => Ord (Frame a)+-- def transmitted_seq_range(df, seq_name):+--     '''+--     test+--     '''+--     log.debug("Computing byte range for sequence field %s", seq_name)++--     sorted_seq = df.dropna(subset=[seq_name]).sort_values(by=seq_name)+--     log.log(mp.TRACE, "sorted_seq %s", sorted_seq)++--     seq_min = sorted_seq.loc[sorted_seq.first_valid_index(), seq_name]+--     last_valid_index = sorted_seq.last_valid_index()+--     seq_max = sorted_seq.loc[last_valid_index, seq_name] \+--         + sorted_seq.loc[last_valid_index, "tcplen"]++--     # -1 because of SYN+--     # seq_range = seq_max - seq_min - 1+--     seq_range = seq_max - seq_min - 1++--     msg = "seq_range ({}) = {} (seq_max) - {} (seq_min) - 1"+--     log.log(mp.TRACE, msg.format(seq_range, seq_max, seq_min))++--     return seq_range, seq_max, seq_min+++  -- where+  --   packetStreams = filterStreamPackets frame streamId (Just role)+    -- log.debug("Getting TCP stats for stream %d", tcpstreamid)+    -- assert destination in ConnectionRoles, "destination is %r" % type(destination)++    -- df = rawdf[rawdf.tcpstream == tcpstreamid]+    -- if df.empty:+    --     raise MpTcpException("No packet with tcp.stream == %d" % tcpstreamid)++    -- df2 = df++    -- log.debug("df2 size = %d" % len(df2))+    -- log.debug("Looking at role %s" % destination)+    -- # assume it's already filtered ?+    -- sdf = df2[df2.tcpdest == destination]+    -- bytes_transferred = Byte(sdf["tcplen"].sum())+    -- assert bytes_transferred >= 0++    -- # -1 to account for SYN+    -- tcp_byte_range, seq_max, seq_min = transmitted_seq_range(sdf, "tcpseq")++    -- # print(sdf["abstime"].head())+    -- # print(dir(sdf["abstime"].dt))+    -- # print(sdf["abstime"].dt.end_time)+    -- times = sdf["abstime"]+    -- tcp_duration = times.iloc[-1] - times.iloc[0]+    -- # duration = sdf["abstime"].dt.end_time - sdf["abstime"].dt.start_time++    -- assert tcp_byte_range is not None++    -- return TcpUnidirectionalStats(+    --     tcpstreamid,+    --     tcp_duration=tcp_duration,+    --     throughput_bytes=bytes_transferred,+    --     # FIX convert to int because Byte does not support np.int64+    --     tcp_byte_range=Byte(tcp_byte_range)+    -- )
+ src/Tshark/Capture.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE CPP #-}+{-+Module:  Tshark.Capture+Description :  Description+Maintainer  : matt+Portability : Linux+-}+module Tshark.Capture+-- (+--    tsharkLoop+-- )+where++-- mptcpanalyzer imports+import Net.Tcp.Connection+import Net.Tcp.Constants+import MptcpAnalyzer.Stream (StreamIdMptcp)+import Net.Mptcp.Connection+import Tshark.Live+import MptcpAnalyzer.Types+import Tshark.Main (csvDelimiter, defaultTsharkPrefs)+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.ArtificialFields+import Net.Tcp.Stats (getTcpStatsFromAFrame)+import Net.Mptcp.Stats++import Control.Monad.State (MonadState(get), StateT, gets, modify')+import qualified Data.Map.Strict as Map+import GHC.IO.Handle+import Pipes (Effect)+import Frames+import qualified Data.Text as T+import Frames.CSV (columnSeparator, ReadRec, ParserOptions, readRow, defaultParser)+import qualified Pipes as P+import qualified Pipes.Parse as P+import qualified Pipes.Prelude as P+import Pipes ((>->))+import Pipes hiding (Proxy)+import Debug.Trace (trace, traceShow, traceShowId)+import System.Console.ANSI+import Data.Vinyl.Functor (getCompose)+import qualified Control.Foldl                 as Foldl+import Control.Lens ((^.), (.~))+import qualified Data.Set as Set+import Data.Maybe (fromJust)+import Data.Either (rights)+import Control.Arrow (first)+import qualified Data.Foldable as F+import qualified Frames as F+import qualified Frames.InCore as F++++pipeTableEitherOpt' :: (Monad m, ReadRec rs)+                   => ParserOptions+                   -> P.Pipe T.Text (Rec (Either T.Text :. ElField) rs) m ()+pipeTableEitherOpt' opts = do+  -- when (isNothing (headerOverride opts)) (() <$ P.await)+  P.map (readRow opts)+++-- produceFrameChunks+-- inCoreAoS+-- --capture-comment+-- TODO return the frame/ stats+tsharkLoopTcp :: LiveStatsConfig -> Handle -> Effect (StateT (LiveStatsTcp) IO) ()+tsharkLoopTcp lsConfig hout = do+  ls <- for (P.fromHandle hout) $ \x -> do+      _ <- liftIO $ putStrLn "newLine"++      -- (frame ::  FrameRec HostCols) <- lift ( inCoreAoS (pipeLines (try. T.hGetLine) hout  >-> pipeTableEitherOpt popts >-> P.map fromEither ))+      -- let x2 :: Text = "1633468309.759952583|eno1|2a01:cb14:11ac:8200:542:7cd1:4615:5e05||2606:4700:10::6814:14ec|||||||||||127|||21.118721618||794|1481|51210|0x00000018|31||3300|443|3||"+      (frame :: FrameRec HostCols) <- liftIO $ inCoreAoS (yield (T.pack x) >-> pipeTableEitherOpt' popts >-> P.map fromEither )+      -- showFrame [csvDelimiter defaultTsharkPrefs] frame+      liftIO $ putStrLn $ showFrame [csvDelimiter defaultTsharkPrefs] frame+      let frameWithDest = addTcpDestinationsToAFrame (FrameTcp (lsConnection lsConfig) frame)++      -- stFrame <- gets lsFrame+      modify' (updateTcpStats frameWithDest)+      -- liftIO $ cursorUp 1+      liveStats <- get+      let output = showLiveStatsTcp liveStats+      liftIO $ cursorUpLine $ (+) 1 (Prelude.length $ T.lines output)+      liftIO clearFromCursorToScreenEnd+      liftIO $ (putStrLn . T.unpack) output++  -- liftIO $ (putStrLn . T.unpack . showLiveStatsTcp) ls+  pure ls++  where+    -- tokenize = tokenizeRow popts+    popts = defaultParser {+          columnSeparator = T.pack $ [csvDelimiter defaultTsharkPrefs]+        }+    fromEither x = case recEither x of+      Left _txt -> error ( "eitherProcessed failure : " ++ T.unpack _txt)+      Right pkt -> pkt++    -- updateStatsFrame :: FrameRec HostCols -> LiveStatsTcp -> LiveStatsTcp+    -- updateStatsFrame frame lstats = foldl updateStats lstats frame+    updateTcpStats frameWithDest tstats = tstats <> genLiveStatsTcp frameWithDest++    recEither = rtraverse getCompose++updateMptcpStats ::+  (+   -- TcpDest F.∈ rs+  MptcpDsn F.∈ rs, TcpSeq F.∈ rs, IpDest F.∈ rs, IpSource F.∈ rs+  , TcpLen F.∈ rs+  , PacketId F.∈ rs+  , TcpDestPort F.∈ rs, MptcpRecvToken F.∈ rs+  , TcpFlags F.∈ rs, TcpSrcPort F.∈ rs, TcpStream F.∈ rs, RelTime F.∈ rs+  , rs F.⊆ HostCols+  , F.RecVec rs+  )+  => FrameFiltered MptcpConnection (F.Record rs)+updateMptcpStats = undefined++-- Tricky function:+-- Contrary to TCP we have to filter on the master subflow but as we can't update the filter as we discover+-- the subflows, we configure tshark to capture all MPTCP traffic and filter it in the application+-- 1/ first we need to find the master subflow+tsharkLoopMptcp :: LiveStatsConfig -> Handle -> Effect (StateT LiveStatsMptcp IO) ()+tsharkLoopMptcp config hout = do+  -- hSetBuffering hout LineBuffering+  -- ls <- for (tsharkProducer hout) $ \x -> do+  ls <- for (P.fromHandle hout) $ \x -> do++      -- (frame ::  FrameRec HostCols) <- lift ( inCoreAoS (pipeLines (try. T.hGetLine) hout  >-> pipeTableEitherOpt popts >-> P.map fromEither ))+      -- let x2 :: Text = "1633468309.759952583|eno1|2a01:cb14:11ac:8200:542:7cd1:4615:5e05||2606:4700:10::6814:14ec|||||||||||127|||21.118721618||794|1481|51210|0x00000018|31||3300|443|3||"+      (frame :: FrameRec HostCols) <- liftIO $ inCoreAoS (yield (T.pack x) >-> pipeTableEitherOpt' popts >-> P.map fromEither )+      -- showFrame [csvDelimiter defaultTsharkPrefs] frame+      liftIO $ putStrLn $ showFrame [csvDelimiter defaultTsharkPrefs] frame+      -- if we have no master subflow yet, we should check against it+      -- so now we should+      mptcpstats <- gets _lsmStats++      -- TODO should be a fmap considering the complexity+      modify' (updateStatsFrame frame)+      -- liftIO $ cursorUp 1+      liveStatsMptcp <- get+      -- showLiveStatsTcp liveStats+      let output = showLiveStatsMptcp liveStatsMptcp++      -- liftIO $ cursorUpLine $ (+) 1 (Prelude.length $ T.lines output)+      liftIO clearFromCursorToScreenEnd+      liftIO $ (putStrLn . T.unpack) output+      -- liftIO $ putStrLn $ "length " ++ show (frameLength stFrame)+      -- lift $ hPutStrLn stdout "test"++  -- liftIO $ (putStrLn . T.unpack . showLiveStatsTcp) ls+  pure ls++  where+    -- tokenize = tokenizeRow popts+    popts = defaultParser {+          columnSeparator = T.pack $ [csvDelimiter defaultTsharkPrefs]+        }+    fromEither x = case recEither x of+      Left _txt -> error ( "eitherProcessed failure : " ++ T.unpack _txt)+      Right pkt -> pkt++    recEither = rtraverse getCompose+++    -- expects a frame and a LiveStatsMptcp+    updateStatsFrame :: FrameRec HostCols -> LiveStatsMptcp -> LiveStatsMptcp+    updateStatsFrame frame lstats = foldl updateStats lstats frame++    updateStats :: LiveStatsMptcp -> Record HostCols -> LiveStatsMptcp+    -- case where the master subflow was already identified+    updateStats lstats@(LiveStatsMptcp (Just main) _ _ subflows stats) row =+      case mbSubflow of+        -- Not a registered subflow yet+        Nothing -> case row ^. mptcpRecvToken of+          Nothing ->+#ifdef DEBUG_CAPTURE+            trace "No rcv token"+#endif+            lstats++          Just rcvToken -> let+              subflow = buildSubflowFromRecord row+            in+#ifdef DEBUG_CAPTURE+              trace "Rcv token received"+#endif+              (+              -- if token of client then subflow initiated by server+              if tokenBelongToConnection rcvToken main then+                lstats {+                  _lsmMaster =+#ifdef DEBUG_CAPTURE+                      trace "Adding new subflow"+#endif+                      (Just (mptcpConnAddSubflow main subflow))++                }+              else+#ifdef DEBUG_CAPTURE+                trace ("ignoring flow " ++ show subflow)+#endif+                lstats+              )+        Just subflowStats ->+          case getSubflowFromStreamId main (row ^. tcpStream) of+            Nothing -> error "Could not find the subflow :s "+            Just subflow -> let+              -- TODO update tcp stats for th+              -- TODO change connection staths when seeing dataFin+              -- TODO update subflow stats and mptcp stats+              -- if row ^. mptcpDataFin+                -- subflow = master+                tcpAframe :: FrameFiltered TcpConnection Packet+                tcpAframe =  FrameTcp (sfConn subflow) frame++                newMptcpStats :: LiveStats MptcpUnidirectionalStats Packet+                newMptcpStats = genLiveStatsMptcp mptcpAframe++                subflowUpdatedStats :: LiveStatsTcp+                subflowUpdatedStats = genLiveStatsTcp (addTcpDestinationsToAFrame tcpAframe)+              in+#ifdef DEBUG_CAPTURE+              trace "known subflow: update stats"+#endif+              (lstats {+                  -- TODO we should have stats in both direction !+                  -- _lsmStats = (lstats ^. lsmStats) <> newMptcpStats+                  _lsmStats = (lstats ^. lsmStats) <> newMptcpStats+                , _lsmSubflows = Map.insert (row ^. tcpStream) (subflowStats <> subflowUpdatedStats) (lstats ^. lsmSubflows)+              })+      where+        tuple = traceShowId (buildTcpConnectionTupleFromRecord row)++        mptcpAframe :: FrameFiltered MptcpConnection Packet+        mptcpAframe =  FrameTcp main frame++        frame :: FrameRec HostCols+        frame = boxedFrame [row]+        mbSubflow = Map.lookup (row ^. tcpStream) (_lsmSubflows lstats)+++    updateStats lstats@(LiveStatsMptcp Nothing (Just clientCfg) (Just serverCfg)  _subflows stats) row = error "should not happen"++      -- in updateStats newStats row+    -- attempts to fetch client mptcp key/token from the initial syn (mptcp version 0)+    updateStats lstats@(LiveStatsMptcp Nothing _ _ _ stats) row =+      -- synPackets = filterFrame (\x -> TcpFlagSyn `elem` (x ^. tcpFlags)) streamPackets+        if hasClientKey then+            -- streamPackets = filterFrame (\x -> x ^. mptcpStream == mympconStreamId) frame+            -- subflows = map (buildSubflowFromTcpStreamId frame) (getTcpStreams streamPackets)+#ifdef DEBUG_CAPTURE+            trace "SYN FOUND! retreiving client key"+#endif+            lstats {+                _lsmClient = traceShowId mptcpConfig+              , _lsmMaster = finalizeLiveStatsMptcp mptcpConfig (_lsmServer lstats)+              , _lsmSubflows = Map.singleton (row ^. tcpStream) (genLiveStatsTcp (FrameTcp (sfConn subflow) mempty))+              -- Set.fromList $ map ffCon (rights subflows)+              }+        else if isSynAck then+          -- lstats & set (traceShowId mptcpConfig)+#ifdef DEBUG_CAPTURE+              trace "SYNACK FOUND! retreiving server key"+#endif+              lstats {+                _lsmServer = traceShowId mptcpConfig+              , _lsmMaster = finalizeLiveStatsMptcp (_lsmClient lstats) mptcpConfig+              }+        else+#ifdef DEBUG_CAPTURE+          trace "No syn\n"+#endif+          lstats+      where+        tuple = traceShowId (buildTcpConnectionTupleFromRecord row)+        -- tcpAframe = buildA+        -- TcpFlagSyn `elem` (row ^. tcpFlags) &&+        hasClientKey = (row ^. mptcpSendKey ) /= Nothing && lsConnection config == tcpConnectionFromOriented tuple+        isSynAck = TcpFlagSyn `elem` (row ^. tcpFlags) &&  TcpFlagAck `elem` (row ^. tcpFlags)+                  && lsConnection config == tcpConnectionFromOriented (reverseTcpConnectionTuple tuple)+        mptcpConfig = genMptcpEndpointConfigFromRow row+        subflow :: MptcpSubflow+        subflow = (MptcpSubflow  (buildTcpConnectionFromRecord row) Nothing Nothing 0 0 Nothing)+        mympconStreamId :: Maybe StreamIdMptcp+        mympconStreamId =  row ^. mptcpStream+        finalizeLiveStatsMptcp :: Maybe MptcpEndpointConfiguration -> Maybe MptcpEndpointConfiguration -> Maybe MptcpConnection+        finalizeLiveStatsMptcp mclientCfg mserverCfg = case (mclientCfg, mserverCfg) of+          (Just clientCfg, Just serverCfg) ->+#ifdef DEBUG_CAPTURE+            trace "FINALIZING MPTCP connection"+#endif+            (Just $ MptcpConnection {+                -- get it from map.singleton+                mpconStreamId = fromJust $ mympconStreamId+              -- fromJust $ synAckPacket ^. mptcpSendKey+              , _mpconServerConfig = serverCfg+              , _mpconClientConfig = clientCfg+              -- , mptcpNegotiatedVersion = mptcpVersion (serverCfg) -- TODO fix+              -- , mpconSubflows = Set.fromList $ map ffCon (rights subflows)+              , _mpconSubflows = Set.singleton subflow+            })+          _ -> Nothing
+ src/Tshark/Fields.hs view
@@ -0,0 +1,144 @@+{-|+Module      : Tshark.Fields+Description : Interface between wireshark output format and haskell+Maintainer  : matt++This module is in charge of loading TCP packets in a haskell format.+This is done by converting between wireshark formats (.pcapng -> .csv) and+using "Frames" to load the resulting data into a frame.++-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+module Tshark.Fields+where+import Net.Stream+import MptcpAnalyzer.Stream++import Data.Text (Text)+import Data.Word (Word16, Word32, Word64, Word8)+import Frames.ShowCSV+import GHC.TypeLits (KnownSymbol)+import Language.Haskell.TH (Name, Q)+import Net.IP+import Net.IPv6 (IPv6(..))+import "mptcp-pm" Net.Tcp.Constants (TcpFlag(..))++import Data.Map (Map, fromList, mapKeys)+-- Phantom types+-- data Mptcp+-- data Tcp+-- -- data Protocol = Tcp | Mptcp++-- -- TODO use Word instead+-- newtype StreamId a = StreamId Word32 deriving (Show, Read, Eq, Ord )++-- type StreamIdTcp = StreamId+-- type StreamIdMptcp = StreamId++type TcpFlagList = [TcpFlag]+type MbPacketIdList = Maybe [Word64]+++type MbMptcpStream = Maybe StreamIdMptcp+type MbMptcpSendKey = Maybe Word64+-- TODO convert to a Word8+type MbMptcpVersion = Maybe Int+type MbMptcpExpectedToken = Maybe Word32++type MbMptcpDsn = Maybe Word64+type MbMptcpDack = Maybe Word64+type MbWord64 = Maybe Word64+++data TsharkFieldDesc = TsharkFieldDesc {+        tfieldFullname :: Text+        -- ^Full wireshark name of the field+        , tfieldColType :: Name+        -- ^Haskell type so that we can generate the proper raw type via templateHaskell+        , tfieldLabel :: Maybe String+        -- ^Pretty field name used as label in plots+        , tfieldHashable :: Bool+        -- ^Wether to take into account this field when creating the hash of a packet+        -- see hash+    }+++type FieldDescriptions = Map Text TsharkFieldDesc++type MbWord32 = Maybe Word32+++-- TODO add this ?+-- data Field = FieldPacketId | FieldInterfaceName++-- MUST BE KEPT IN SYNC WITH  Pcap.hs HostCols ORDER INCLUDED !+baseFields :: FieldDescriptions+baseFields = fromList [+    ("packetId", TsharkFieldDesc "frame.number" ''Word64 Nothing False)+    , ("interfaceName", TsharkFieldDesc "frame.interface_name" ''Text Nothing False)+    , ("absTime", TsharkFieldDesc "frame.time_epoch" ''Double Nothing False)+    , ("relTime", TsharkFieldDesc "frame.time_relative" ''Double Nothing False)+    , ("ipSource", TsharkFieldDesc "_ws.col.ipsrc" ''IP (Just "source ip") True)+    , ("ipDest", TsharkFieldDesc "_ws.col.ipdst" ''IP (Just "destination ip") True)+    , ("ipSrcHost", TsharkFieldDesc "ip.src_host" ''Text (Just "source ip hostname") False)+    , ("ipDstHost", TsharkFieldDesc "ip.dst_host" ''Text (Just "destination ip hostname") False)+    , ("tcpStream", TsharkFieldDesc "tcp.stream" ''StreamIdTcp Nothing False)+    , ("tcpSrcPort", TsharkFieldDesc "tcp.srcport" ''Word16 Nothing True)+    , ("tcpDestPort", TsharkFieldDesc "tcp.dstport" ''Word16 Nothing True)+    , ("rwnd", TsharkFieldDesc "tcp.window_size" ''Word32 Nothing True)+    , ("tcpFlags", TsharkFieldDesc "tcp.flags" ''TcpFlagList Nothing True)+    , ("tcpOptionKinds", TsharkFieldDesc "tcp.option_kind" ''Text Nothing True)+    , ("tcpSeq", TsharkFieldDesc "tcp.seq" ''Word32 (Just "Sequence number") True)+    , ("tcpLen", TsharkFieldDesc "tcp.len" ''Word16 (Just "Tcp Len") True)+    , ("tcpAck", TsharkFieldDesc "tcp.ack" ''Word32 (Just "Tcp ACK") True)++    , ("tsval", TsharkFieldDesc "tcp.options.timestamp.tsval" ''MbWord32 (Just "Timestamp val") True)+    , ("tsecr", TsharkFieldDesc "tcp.options.timestamp.tsecr" ''MbWord32 (Just "Timestamp echo-reply") True)++    -- could be computed from the sendKey+    , ("mptcpExpectedToken", TsharkFieldDesc "mptcp.expected_token" ''MbMptcpExpectedToken (Just "Expected token") True)++    , ("mptcpStream", TsharkFieldDesc "mptcp.stream" ''MbMptcpStream Nothing False)+    , ("mptcpSendKey", TsharkFieldDesc "tcp.options.mptcp.sendkey" ''MbWord64 Nothing True)+    , ("mptcpRecvKey", TsharkFieldDesc "tcp.options.mptcp.recvkey" ''MbWord64 Nothing True)+    , ("mptcpRecvToken", TsharkFieldDesc "tcp.options.mptcp.recvtok" ''MbMptcpExpectedToken Nothing True)+    -- TODO bool+    , ("mptcpDataFin", TsharkFieldDesc "tcp.options.mptcp.datafin.flag" ''MbWord64 Nothing True)+    , ("mptcpVersion", TsharkFieldDesc "tcp.options.mptcp.version" ''MbMptcpVersion Nothing True)+    , ("mptcpDack", TsharkFieldDesc "mptcp.ack" ''MbWord64 (Just "DataAck") True)+    , ("mptcpDsn", TsharkFieldDesc "mptcp.dsn" ''MbWord64 (Just "Data Sequence Number") True)++    -- these ones are experimental+    , ("relatedMappings", TsharkFieldDesc "mptcp.related_mapping" ''MbWord64 Nothing False)+    , ("reinjectionOf", TsharkFieldDesc "mptcp.reinjection_of" ''MbPacketIdList Nothing False)+    , ("reinjectedIn", TsharkFieldDesc "mptcp.reinjection_of" ''MbPacketIdList Nothing True)+    ]++-- fakeBaseFields :: FieldDescriptions+-- fakeBaseFields = [+--     ("fakePacketId", TsharkFieldDesc "frame.number" ''Word64 Nothing False)+--     , ("fakeInterfaceName", TsharkFieldDesc "frame.interface_name" ''Text Nothing False)+--     ]+-- fakeBaseFields2 :: FieldDescriptions+-- fakeBaseFields2 = prefixFields "fake_" fakeBaseFields++-- TODO+prefixFields :: Text -> FieldDescriptions -> FieldDescriptions+prefixFields prefix descs =+  -- map (\(name, field) -> (prefix<>name , field))+  mapKeys (\name -> prefix<>name) descs++-- this should actually be host2+baseFieldsHost2 :: FieldDescriptions+baseFieldsHost2 = prefixFields "test_" baseFields+++baseFieldsSender :: FieldDescriptions+baseFieldsSender = prefixFields "snd_" baseFields++baseFieldsReceiver :: FieldDescriptions+baseFieldsReceiver = prefixFields "rcv_" baseFields
+ src/Tshark/Interfaces.hs view
@@ -0,0 +1,40 @@+{-|+Module      : Tshark.Interfaces+Description : List host interfaces+Maintainer  : matt+License     : GPL-3+-}+module Tshark.Interfaces (+  listInterfaces+)+where++import Polysemy+import Polysemy.Embed+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import System.Exit+import System.IO+import System.Process+++-- listInterfaces :: (Members [Log, Embed IO ] m) => Sem m (ExitCode, [String])+-- | List network interfaces (just their names) that are visible by tshark+listInterfaces :: IO (ExitCode, [String])+listInterfaces =+    -- defaultTsharkPrefs+    let+      (RawCommand bin args) = (RawCommand "tshark" [ "--list-interfaces" ])+      createProc :: CreateProcess+      createProc = (proc bin args) { std_out = CreatePipe }+    in do+      (_, mbHout, mbHerr, ph) <- createProcess_ "error" createProc+      exitCode <- waitForProcess ph+      -- TODO do it only in case of error ?+      case mbHout of+        Nothing -> error "no out"+        Just hout -> do+          out <- hGetContents hout+          -- err <- hGetContents herr+          return (exitCode, map (head. tail . words) (lines out))+
+ src/Tshark/Live.hs view
@@ -0,0 +1,296 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-|+Module: Tshark.Live+Description : Load incrementally a PCAP into a frame+Maintainer  : matt+Portability : Linux+-}+module Tshark.Live (+    showLiveStatsTcp+  , showLiveStatsMptcp+  , LiveStats(..)+  , LiveStatsTcp+  , LiveStatsConfig(..)+  , LiveStatsMptcp(..)+  , lsmMaster, lsmSubflows, lsmStats+  , mkLiveStatsMptcp+  , genLiveStatsMptcp+  , genLiveStatsTcp+  -- , CaptureSettingsMptcp+)+where+++import Tshark.Main (csvDelimiter, defaultTsharkPrefs)+import Net.Stream+import Net.Mptcp.Stats++import Data.Text as T+import qualified Data.Map.Strict as Map+import Control.Lens++import GHC.IO.Handle+import Pipes ((>->))+import Pipes hiding (Proxy)+-- import Control.Monad.Primitive+import Control.Exception (IOException, try)+import Control.Monad (liftM, unless, when)+import Data.Maybe (isNothing)+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Map.Strict as Map+import Data.Vinyl.Functor (Compose(..), (:.))+import Debug.Trace (trace, traceShow, traceShowId)+import Frames+import Frames.CSV+       ( ParserOptions+       , ReadRec+       , columnSeparator+       , defaultParser+       , headerOverride+       , pipeTableEitherOpt+       , pipeTableMaybeOpt+       , readRecEither+       , readRow+       , tokenizeRow+       )+import Frames.Exploration+import MptcpAnalyzer.Types (HostCols, Packet, PacketWithTcpDest)+import qualified Pipes as P+import qualified Pipes.Parse as P+import qualified Pipes.Prelude as P+import qualified Pipes.Safe as P++import Control.Monad.State (MonadState(get), StateT, gets, modify')+import Control.Monad.State.Lazy (execStateT)+import Data.Text.IO (hPutStrLn)+import MptcpAnalyzer (FrameFiltered(ffFrame))+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Pcap (addTcpDestinationsToAFrame)+import MptcpAnalyzer.Types (FrameFiltered(FrameTcp))+import Net.Mptcp.Stats (MptcpUnidirectionalStats)+import Net.Mptcp.Connection (MptcpConnection(MptcpConnection))+import Net.Mptcp.Stats (MptcpUnidirectionalStats, showMptcpUnidirectionalStats, TcpSubflowUnidirectionalStats)+import Net.Tcp (TcpConnection)+import Net.Tcp.Stats+       (TcpUnidirectionalStats, getTcpStatsFromAFrame, showTcpUnidirectionalStats)+import System.Console.ANSI+import System.IO (stdout)+import Net.Mptcp.Connection+import qualified Data.Set as Set+import GHC.Word (Word64, Word32)+import MptcpAnalyzer.Utils.Text+++-- --         +--------+-- A 'Producer' that yields 'String's+-- --         |        |+-- --         |        |      +-- Every monad transformer has a base monad.+-- --         |        |      |   This time the base monad is 'IO'.+-- --         |        |      |+-- --         |        |      |  +-- Every monadic action has a return value.+-- --         |        |      |  |   This action returns '()' when finished+-- --         v        v      v  v+-- stdinLn :: Producer String IO ()+-- stdinLn = do+--     eof <- lift isEOF        -- 'lift' an 'IO' action from the base monad+--     unless eof $ do+--         res <- lift getLine+--         yield res            -- 'yield' the 'String'+--         stdinLn              -- Loop++-- loop :: Effect IO ()+-- loop = for stdinLn $ \x -> do  -- Read this like: "for str in stdinLn"+--     lift $ putStrLn x++-- | Opens a file (in 'P.MonadSafe') and repeatedly applies the given+-- function to the 'Handle' to obtain lines to yield. Adapted from the+-- moribund pipes-text package.+pipeLines :: P.MonadSafe m+          => (Handle -> IO (Either IOException T.Text))+          -> Handle+          -> P.Producer T.Text m ()+pipeLines pgetLine h =+  let loop = do txt <- P.liftIO (pgetLine h)+                case txt of+                  Left _e -> return ()+                  Right y -> P.yield y >> loop+  in loop++-- | Produce lines of 'T.Text'.+-- produceTextLines :: P.MonadSafe m => FilePath -> P.Producer T.Text m ()+-- produceTextLines = pipeLines (try . T.hGetLine)++-- | Show live stats TCP+-- showLiveStatsTcp :: LiveStatsTcp -> Text+-- showLiveStatsTcp stats = T.unlines [+--   showLiveStats (SomeStats stats)+--   , showTcpUnidirectionalStats (lsStats stats)+--   ]++data SomeStats where+  SomeStats :: LiveStats a b -> SomeStats+++showLiveStatsTcp :: LiveStatsTcp -> Text+showLiveStatsTcp  liveStats =+      T.unlines (+           [ "Completed ?: " <> tshow (lsHasFinished liveStats) ]+        -- ++ if lsDestination liveStats == RoleServer then else []+        ++ ["Showing towards server: ", showTcpUnidirectionalStats (lsForwardStats liveStats)]+        -- ++ if lsDestination liveStats == RoleClient then else []+        ++ ["Showing towards client: ", showTcpUnidirectionalStats (lsBackwardStats liveStats)]+        )++++-- type UpdateFrameFunc a b = Frame a -> Frame a -> (Frame a, b)++-- | Hold information on a connection+-- data LiveStats = LiveStats {+--   -- lsCon :: MptcpConnection,+--   lsStats :: MptcpUnidirectionalStats+--   , lsPackets :: Int+--   -- , lsFrame :: FrameFiltered TcpConnection Packet+--   , lsFrame :: FrameRec HostCols+--   }++-- TODO rename to liveplotConfig ?+data LiveStatsConfig = LiveStatsConfig {+    lsConnection :: TcpConnection+  , lsDestination :: ConnectionRole+  }++-- TODO should be instance of a Monoid !+-- | for now unidirectional ?+data LiveStats stats packet = LiveStats {+  -- lsCon :: MptcpConnection,+    lsForwardStats :: stats+  , lsBackwardStats :: stats+  -- keep to check everything worked fine? else we can retreive the count from lsFrame+  , lsPackets :: Int+  -- , lsConnection :: TcpConnection+  , lsFrame :: Frame packet+  -- , lsFrame :: FrameFiltered con packet+  , lsHasFinished :: Bool+  -- ^ True once it sees a FIN+  -- , lsFrame :: FrameRec HostCols+  }++instance Semigroup stats => Semigroup (LiveStats stats packets) where+  (<>) a b = LiveStats {+        lsForwardStats = lsForwardStats a <> lsForwardStats b+      , lsBackwardStats = lsBackwardStats a <> lsBackwardStats b+      , lsPackets = lsPackets a + lsPackets b+      , lsFrame = lsFrame a <> lsFrame b+      , lsHasFinished = (lsHasFinished a) || (lsHasFinished b)+    }+++instance Monoid stats => Monoid (LiveStats stats packets) where+  mempty = LiveStats {+      lsForwardStats = mempty+    , lsBackwardStats = mempty+    -- keep to check everything worked fine? else we can retreive the count from lsFrame+    , lsPackets = 0+    -- , lsConnection :: TcpConnection+    , lsFrame = mempty+    -- , lsFrame :: FrameFiltered con packet+    , lsHasFinished = False+    }++type LiveStatsTcp = LiveStats TcpUnidirectionalStats Packet++-- data LiveStatsTcp = LiveStatsTcp {+--     _lstConn :: Maybe TcpConnection+--   , _lstStats :: LiveStats TcpUnidirectionalStats Packet+--   }+-- type LiveStatsMptcp = LiveStats MptcpUnidirectionalStats MptcpConnection Packet++-- should be richer+data LiveStatsMptcp = LiveStatsMptcp {+    -- tcpStreamId+    _lsmMaster :: Maybe MptcpConnection++  , _lsmClient :: Maybe MptcpEndpointConfiguration+  -- ^ Key / Token+  , _lsmServer :: Maybe MptcpEndpointConfiguration+  -- ^ (Key, Token)+  , _lsmSubflows :: Map.Map StreamIdTcp LiveStatsTcp+        -- (TcpSubflowUnidirectionalStats, TcpSubflowUnidirectionalStats)+  -- ^ TODO these should be subflow stats (dss/dsn)+  , _lsmStats :: LiveStats MptcpUnidirectionalStats Packet+  }++makeLenses ''LiveStatsMptcp++-- |Search for the master subflow+-- TODO could+getMasterSubflow :: [MptcpSubflow] -> Maybe MptcpSubflow+getMasterSubflow l = case Prelude.filter (isNothing . sfJoinToken) l of+  [] -> Nothing+  (x:_) -> Just x++-- helper to create LiveStatsMptcp+mkLiveStatsMptcp :: LiveStatsMptcp+mkLiveStatsMptcp = LiveStatsMptcp {+          _lsmMaster = Nothing+        , _lsmClient = Nothing+        , _lsmServer = Nothing+        , _lsmSubflows = mempty+        , _lsmStats = mempty+        }+-- type CaptureSettingsMptcp = LiveStatsMptcp++-- TODO +genLiveStatsTcp :: FrameFiltered TcpConnection PacketWithTcpDest -> LiveStatsTcp+genLiveStatsTcp frameWithDest@(FrameTcp _ frame) = let+        forwardFrameWithDest = getTcpStatsFromAFrame frameWithDest RoleServer+        backwardFrameWithDest = getTcpStatsFromAFrame frameWithDest RoleClient+    in (mempty :: LiveStatsTcp) {+      lsPackets = frameLength frame+    -- , lsFrame = frame+    , lsForwardStats = let+        merged = +          -- trace ("FRAMEWITH DEST\n" ++ showFrame [csvDelimiter defaultTsharkPrefs] (ffFrame frameWithDest) ++ "\n " ++ show forwardFrameWithDest)+          forwardFrameWithDest+        in merged+    , lsBackwardStats =  backwardFrameWithDest+    }+++genLiveStatsMptcp :: FrameFiltered MptcpConnection Packet -> LiveStats MptcpUnidirectionalStats Packet+genLiveStatsMptcp mptcpAframe =  (mempty :: LiveStats MptcpUnidirectionalStats Packet) {+    lsPackets = frameLength $ ffFrame mptcpAframe+  , lsFrame = ffFrame mptcpAframe+  , lsForwardStats = getMptcpStats mptcpAframe RoleServer+  , lsBackwardStats = getMptcpStats mptcpAframe RoleClient+  }+++showLiveStatsMptcp :: LiveStatsMptcp -> Text+showLiveStatsMptcp stats = T.unlines [+      "Forward: "  <> showMptcpUnidirectionalStats (lsForwardStats $ stats ^. lsmStats)+    , "Backward: " <> showMptcpUnidirectionalStats (lsBackwardStats $ stats ^. lsmStats)+    ]++showLiveStats :: SomeStats -> Text+showLiveStats (SomeStats liveStats) =+  T.unlines [+    "Number of packets: " <> tshow (lsPackets liveStats)+  ]+++-- tsharkProducer :: Handle -> Producer Text TsharkMonad ()+-- tsharkProducer hout = do+--     liftIO $ trace ("show hout " ++ show hout) hSetBuffering hout NoBuffering+--     output <- liftIO $ trace "hgetline" hGetLine hout+--     trace "yield" yield (T.pack output)+--     tsharkProducer hout++---- Accept as input the different handles+--readTsharkOutputAndPlotIt :: Handle -> Handle -> IO ()+--readTsharkOutputAndPlotIt hout herr = do+--  -- use pipeTableEitherOpt to parse+--  output <- hGetContents hout+--  putStrLn output
+ src/Tshark/Main.hs view
@@ -0,0 +1,145 @@+{-|+Module      : Tshark.Main+Description : Interface between wireshark output format and haskell+Maintainer  : matt+++WIRESHARK_CONFIG_DIR'++-}+module Tshark.Main (+  TsharkParams(csvDelimiter, tsharkReadFilter)+  , generateCsvCommand+  , defaultTsharkPrefs+  , defaultTsharkOptions+  , genReadFilterFromTcpConnection+  , genReadFilterMptcpFromMptcpConnection+)+where++import Data.List (intercalate)+import qualified Data.Text as T+import MptcpAnalyzer.ArtificialFields (ConnectionRole(RoleClient, RoleServer))+import qualified Net.IP+import Net.Tcp (TcpConnection(..))+import System.Process++-- http://acowley.github.io/Frames/#orgf328b25+defaultTsharkOptions :: [(String, String)]+defaultTsharkOptions = [+      -- TODO join these+      ("gui.column.format", intercalate "," [ "Time","%At","ipsrc","%s","ipdst","%d"]),+      -- "tcp.relative_sequence_numbers": True if tcp_relative_seq else False,+      ("tcp.analyze_sequence_numbers", "true"),+      ("mptcp.analyze_mappings", "true"),+      ("mptcp.relative_sequence_numbers", "true"),+      ("mptcp.intersubflows_retransmission", "true"),+      -- # Disable DSS checks which consume quite a lot+      ("mptcp.analyze_mptcp", "true")+      ]+++defaultTsharkPrefs :: TsharkParams+defaultTsharkPrefs = TsharkParams {+      tsharkBinary = "tshark",+      tsharkOptions = defaultTsharkOptions+      , csvDelimiter = '|'+      , tsharkReadFilter = Just "mptcp or tcp and not icmp"+      , tsharkProfile = Nothing+    }++showIP :: Net.IP.IP -> String+showIP = T.unpack . Net.IP.encode+++-- |One way filter+-- genReadFilterUnidirectional ::+-- genReadFilterUnidirectional =++-- genReadFilterBidirectional ::+-- genReadFilterBidirectional =++-- |Create a tshark read filter from a 'TcpConnection'+genReadFilterFromTcpConnection ::+  TcpConnection+  -> Maybe ConnectionRole   -- ^If we care about direction (ignored for now)+  -> String+genReadFilterFromTcpConnection con dest =+  case dest of+    Just RoleClient ->+      -- TODO should depend on destination+      "tcp and ip.src==" ++ (showIP . conTcpClientIp) con ++ " and ip.dst==" ++ (showIP . conTcpServerIp) con+        ++ " and tcp.srcport==" ++ show (conTcpClientPort con) ++ " and tcp.dstport==" ++ show (conTcpServerPort con)+    Just RoleServer ->+      "tcp and ip.src==" ++ (showIP . conTcpServerIp) con ++ " and ip.dst==" ++ (showIP . conTcpClientIp) con+        ++ " and tcp.srcport==" ++ show (conTcpServerPort con) ++ " and tcp.dstport==" ++ show (conTcpClientPort con)++        -- error "not implemented"+    -- TODO 2 requretes srcport dstport puis alterne+    _nodestination -> "tcp and ip.addr==" ++ (showIP . conTcpClientIp) con ++ " and ip.addr==" ++ (showIP . conTcpServerIp) con+        ++ " and tcp.port==" ++ show (conTcpServerPort con) ++ " and tcp.port==" ++ show (conTcpClientPort con)++-- |Create a tshark read filter from a 'MptcpConnection'+-- genReadFilterFromMptcpConnection :: MptcpConnection -> String+-- genReadFilterFromMptcpConnection con =+++-- we cant update the filter on the fly so we need to look at all the mptcp traffic+-- and match on master subflow+genReadFilterMptcpFromMptcpConnection :: String+genReadFilterMptcpFromMptcpConnection = "mptcp"++++-- | Basic wireshark settings to enforce reproducible results across users+data TsharkParams = TsharkParams {+      tsharkBinary     :: String,+      -- |(Name, Value) of tshark options, see 'defaultTsharkOptions'+      tsharkOptions    :: [(String, String)],+      -- | Flags to add on the command line+      -- tsharkFlags     :: [String],+      -- | How to separate the different fields+      csvDelimiter     :: Char+      -- | for instance "mptcp" or "tcp"+      , tsharkReadFilter :: Maybe String++      -- | Path towards the tshark profile to use (passed as `tshark -C ...`)+      , tsharkProfile :: Maybe FilePath+    }+++-- |Generate the tshark command to export a pcap into a csv+generateCsvCommand :: [T.Text] -- ^Fields to exports e.g., "mptcp.stream"+          -> Either String FilePath    -- ^ (interface, path towards the pcap file)+          -> TsharkParams+          -> CmdSpec+generateCsvCommand fieldNames source tsharkParams =+    RawCommand (tsharkBinary tsharkParams ) args+    where+    -- for some reasons, -Y does not work so I use -2 -R instead+    -- quote=d|s|n Set the quote character to use to surround fields.  d uses double-quotes, s+    -- single-quotes, n no quotes (the default).+    -- the -2 is important, else some mptcp parameters are not exported+        start = [+            "-E", "separator=" ++ [csvDelimiter tsharkParams]+          ] ++ (case source of+              Right pcapFilename -> ["-r", pcapFilename]+              Left ifname  -> ["-i", ifname])+++        args :: [String]+        args = (start ++ opts ++ readFilter ) ++ map T.unpack  fields++        opts :: [String]+        opts = foldr (\(opt, val) l -> l ++ ["-o", opt ++ ":" ++ val]) [] (tsharkOptions tsharkParams)++        readFilter :: [String]+        readFilter = case tsharkReadFilter tsharkParams of+            Just x  -> (case source of+              Right pcapFilename -> ["-2", "-R"]+              Left ifname  -> ["-Y"]) ++ [x]+            Nothing -> []++        fields :: [T.Text]+        fields = ["-T", "fields"]+            ++ Prelude.foldr (\fieldName l -> ["-e", fieldName] ++ l) [] fieldNames
+ src/Tshark/Sharkd.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}+-- +--+-- Format of request listed at <https://gitlab.com/wireshark/wireshark/-/wikis/sharkd-Request-Syntax#tap>+module Tshark.Sharkd (++    defaultSocketPath+  , launchSharkd+  , connectToSharkd+  , loadFile+  )+where++import Network.Socket+import Network.Socket.ByteString+import Data.Aeson+import Data.Aeson.Encode.Pretty+import Data.Aeson.Extra.Merge (lodashMerge)+import System.Process hiding (runCommand)+import qualified Control.Exception as E+import Data.ByteString.Lazy (toStrict)+import GHC.IO.Handle+import Control.Concurrent+import qualified Data.ByteString as S+import Foreign (Ptr)+import Foreign.C (CChar)+import Data.Aeson.Encoding (encodingToLazyByteString)+++defaultSocketPath :: FilePath+defaultSocketPath = "/tmp/sharkd.sock"++basicPayload :: String -> Series+basicPayload method = +        "method" .= toJSON method+        <> "jsonrpc" .= toJSON ("2.0" :: String)+        <> "id" .= toJSON (1 ::Int)+      -- , "params" .= object [+      --     "file" .= pcapPath+      --   ]++++basicPayloadStr :: String -> String+basicPayloadStr inside = "{'jsonrpc': '2.0', 'id': 1, 'method':'info'}"+++-- | Launches the wireshark daemon+launchSharkd :: FilePath -- ^ Unix socket path+      -> IO ()+launchSharkd socketPath = let+    createProc :: CreateProcess+    createProc = (proc "sharkd" [ socketPath ]) {+      delegate_ctlc = True+    }+  in do+    putStrLn $ "Launching " ++ show createProc+    (_, _, mbHerr, ph) <- createProcess createProc+    pure ()+    -- waitForProcess ph+++-- | +-- serializingConfig :: Config+-- serializingConfig = defConfig { confCompare = compare }++connectToSharkd :: FilePath -> IO ()+connectToSharkd = undefined++-- TODO should return a Either String Value instead ?+sendRequestToSharkd :: FilePath -> Encoding -> IO (Either String Value)+sendRequestToSharkd sockPath payload = do+  E.bracketOnError (socket AF_UNIX Stream defaultProtocol) close $ \sock -> do+      -- setSocketOption sock ReuseAddr 1+      -- withFdSocket sock setCloseOnExecIfNeeded+      -- sock <- socket AF_UNIX Stream defaultProtocol+      putStrLn $ "connecting to socket " ++ show sockPath++      connect sock (SockAddrUnix sockPath)++      putStrLn "connected"+      -- m <- newEmptyMVar+      -- forkIO $ (listenForResponse h m)+      putStrLn $ "sending payload " ++ show payload+      let bsPayload = (toStrict $ encodingToLazyByteString payload ) <> "\n"+      putStrLn $ "sending payload " ++ show bsPayload+      sendAll sock bsPayload+      putStrLn "sent"+      bs <- recv sock 1024+      putStrLn "recv"+      print bs+      return $ eitherDecodeStrict bs+  where+    -- socket AF_UNIX Stream defaultProtocol+    addr = defaultHints  { addrFamily = AF_UNIX, addrAddress = SockAddrUnix sockPath }++-- |+-- {"req":"load","file":"c:/traces/Contoso_01/web01/web01_00001_20161012151754.pcapng"}+loadFile :: FilePath -> FilePath -> IO ()+loadFile pcapPath sockPath =++  sendRequestToSharkd sockPath (pairs payload) >> return ()+  where+    payload = basicPayload "load" <> paramsPayload +    paramsPayload = +          "params" .= object [+            "file" .= pcapPath+          ]++-- this works+getInfo :: FilePath -> IO ()+getInfo sockPath = sendRequestToSharkd sockPath (pairs payload) >> return ()+  where+    payload = basicPayload "info"++-- {"req":"status"}++-- getStatus :: Socket -> IO ()+-- getStatus sock = sendRequestToSharkd defaultSocketPath payload >> return ()+--   where+--     payload = object [+--         "req" .= toJSON ("status" :: String)+--       ]++-- {"req":"frames","filter":"frame.number<=20"}+-- getFrames+-- getFrames+
+ src/Tshark/TH.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Tshark.TH (+  declarePrefixedColumns+  , genExplicitRecord+  , genRecordFrom+  , genRecordFromHeaders+  , genRecHashable+)+where++import Tshark.Fields++import Control.Arrow (first, second)+import qualified Data.Text as T+import Data.Word (Word16, Word32, Word64)+import GHC.TypeLits+import Language.Haskell.TH+import Net.IP+-- import Language.Haskell.TH.Syntax+import Data.Vinyl ()+import Language.Haskell.TH.Syntax (Q, sequenceQ)+-- for ( (:->)())+import Frames.Col ()+-- ((:->))+import Frames+import Frames.TH hiding (rowTypeName, tablePrefix)+-- import Frames+import Control.Monad (foldM)+import Data.Char (toLower)+import Data.Map (mapWithKey, toList)+import qualified Data.Map as Map+import Data.Proxy (Proxy(..))+import Frames.Utils+++-- WARN the behavior here differs from Frames+declarePrefixedColumns :: Text -> FieldDescriptions -> DecsQ+declarePrefixedColumns prefix fields = do+  foldM toto mempty (toList fields)+  where+    -- acc +++    toto acc (colName, field) = do+      -- Note: Frames.declarePrefixedColumn doesn't prefix the colName but the accessors !+      -- expects colName lensPrefix type+      t <- declarePrefixedColumn (prefix <> colName) prefix (tfieldColType field)+      return $ acc ++ t++-- TODO search frames.TH+-- Generates a '[ ]+-- la solution est dans tableTypesText'+-- Generate a FieldRec+-- TODO rename+genRecordFrom :: String -> FieldDescriptions -> DecsQ+genRecordFrom  = genRecordFromHeaders ""++-- rename to explicit / upstream+-- ici on presuppose que les colonnes existrent deja en fait ?+genRecordFromHeaders :: String -> String -> FieldDescriptions -> DecsQ+genRecordFromHeaders tablePrefix rowTypeName fields = genExplicitRecord tablePrefix rowTypeName converted+  where+    converted = map (\(name, field) -> (name, tfieldColType field)) (toList fields)++-- mergedFields :: [(String, Name)]+-- FieldDescriptions+-- tablePrefix here consists in the lenses but not the actual column names+genExplicitRecord :: String -> String -> [(Text, Name)] -> Q [Dec]+genExplicitRecord tablePrefix rowTypeName fields = do+  (colTypes, colDecs) <- second concat . unzip+                        <$> mapM (uncurry mkColDecs) headers+  -- let recTy = TySynD (mkName rowTypeName) [] (recDec colTypes)+  let recTy = TySynD (mkName rowTypeName) [] (qqDec colTypes)+  return [recTy]+  where+    -- colTypes = map (\(name, field) -> (name, colType field)) fields+    -- TODO headers+    -- headers :: [(Text, Type)]+    headers = zip colNames (repeat (ConT ''T.Text))+    -- colNames :: [Text]+    colNames = map fst fields+    mkColDecs colNm colTy = do+      let safeName = T.unpack (sanitizeTypeName colNm)+      mColNm <- lookupTypeName (tablePrefix ++ safeName)+      case mColNm of+        Just n -> pure (ConT n, [])+        Nothing -> colDec (T.pack tablePrefix) rowTypeName colNm (Right colTy)+++genRecHashable :: String -> FieldDescriptions -> DecsQ+genRecHashable prefix fields = genRecordFrom prefix (Map.filter tfieldHashable  fields)++-- inspired from recDec+qqDec :: [Type] -> Type+qqDec = go+  where go [] = PromotedNilT+        go (t:cs) = AppT (AppT PromotedConsT t) (go cs)++-- TODO make public in Frames+-- table+-- mkColDecs :: T.Text -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec])+-- mkColDecs colNm colTy = do+--   let tablePrefix = ""+--   let rowTypeName = "toto"+--   let safeName = tablePrefix ++ (T.unpack . sanitizeTypeName $ colNm)+--   mColNm <- lookupTypeName safeName+--   case mColNm of+--     Just n -> pure (ConT n, []) -- Column's type was already defined+--     Nothing -> colDec (T.pack tablePrefix) rowTypeName colNm colTy+++-- | Generate a column type.+-- recDecExplicit :: [(T.Text, Q Type)] -> Q Type+-- recDecExplicit = appT [t|Record|] . go+--   where go [] = return PromotedNilT+--         go ((n,t):cs) =+--           [t|($(litT $ strTyLit (T.unpack n)) :-> $t) ': $(go cs) |]++-- TODO pass on rowTypeName+-- myRowGen :: String -> [(T.Text, TsharkFieldDesc)] -> DecsQ+-- myRowGen rowName fields = do+--   rowType <- recDecExplicit tfields+--   -- let recTy = TySynD (mkName rowTypeName) [] (recDec colTypes)+--   let recTy = TySynD (mkName rowName) [] rowType+--   colDecs <- concat <$> mapM (uncurry $ colDecExplicit (T.pack tablePrefix)) headers+--   return [recTy]+--   where+--       tfields = map (\(colName, fullField) -> (colName, colType fullField)) fields+--++--myRow :: [(T.Text, TsharkFieldDesc)] -> RowGen a+--myRow fields = RowGen [] "" "|" "HostCols" []+--  where+--    --+--    tfields = map (\(colName, fullField) -> (colName, colType fullField)) fields++-- type CommonColumns = [Bool, Int, Double, T.Text]+-- rowGen :: FilePath -> RowGen CommonColumns++-- myColumnUniverse :: String -> FieldDescriptions -> Q [Dec]+-- myColumnUniverse rowTypeName fields = do+--     let colTys = map (\(_name, x) -> colType x) fields+--     colTypes <- tySynD (mkName rowTypeName) [] (promotedTypeList colTys)+--     -- colTypes <- sequenceQ colTys+--     -- f <- sequenceA (colTypes)+--     return [colTypes]+--     -- return $ tySynD colTys+--     -- where+--     --   colTypes :: Q Type+++promotedTypeList :: [Q Type] -> Q Type+promotedTypeList []     = promotedNilT+promotedTypeList (t:ts) = [t| $promotedConsT $t $(promotedTypeList ts) |]+
+ src/app/Main.hs view
@@ -0,0 +1,676 @@+{-|+Description : Mptcpanalyzer+Maintainer  : matt++* Tutorial++Accepts as input(s) capture file(s) (\*.pcap) and depending on from there can :++* list the MPTCP connections in the pcap+* display some statistics on a specific MPTCP connection (list of subflows etc...);+* convert packet capture files (\*.pcap) to \*.csv files+* plot data sequence numbers for all subflows+* `XDG compliance <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>`_, i.e.,+  |prog| looks for files in certain directories. will try to load your configuration from `$XDG_CONFIG_HOME/mptcpanalyzer/config`+* caching mechanism: mptcpanalyzer compares your pcap creation time and will+  regenerate the cache if it exists in `$XDG_CACHE_HOME/mptcpanalyzer/<path_to_the_file>`+* support 3rd party plugins (plots or commands)++Most commands are self documented and/or with autocompletion.++Then you have an interpreter with autocompletion that can generate & display plots such as the following:++![Data Sequence Number (DSN) per subflow plot](examples/dsn.png)+++How to associate an MP_JOIN to its MPTCP connection ?++See https://tools.ietf.org/html/draft-ietf-mptcp-rfc6824bis-02#page-40 for mor details:+++   The token is used to identify the MPTCP connection and is a+   cryptographic hash of the receiver's key, as exchanged in the initial+   MP_CAPABLE handshake (Section 3.1).  In this specification, the+++   tokens presented in this option are generated by the SHA-1 ([4],+   [17]) algorithm, truncated to the most significant 32 bits.  The+   token included in the MP_JOIN option is the token that the receiver+   of the packet uses to identify this connection; i.e., Host A will+   send Token-B (which is generated from Key-B).  Note that the hash+   generation algorithm can be overridden by the choice of cryptographic+   handshake algorithm, as defined in Section 3.1.++              Host A                                  Host B+     ------------------------                       ----------+     Address A1    Address A2                       Address B1+     ----------    ----------                       ----------+         |             |                                |+         |            SYN + MP_CAPABLE(Key-A)           |+         |--------------------------------------------->|+         |<---------------------------------------------|+         |          SYN/ACK + MP_CAPABLE(Key-B)         |+         |             |                                |+         |        ACK + MP_CAPABLE(Key-A, Key-B)        |+         |--------------------------------------------->|+         |             |                                |+         |             |   SYN + MP_JOIN(Token-B, R-A)  |+         |             |------------------------------->|+         |             |<-------------------------------|+         |             | SYN/ACK + MP_JOIN(HMAC-B, R-B) |+         |             |                                |+         |             |     ACK + MP_JOIN(HMAC-A)      |+         |             |------------------------------->|+         |             |<-------------------------------|+         |             |             ACK                |++   HMAC-A = HMAC(Key=(Key-A+Key-B), Msg=(R-A+R-B))+   HMAC-B = HMAC(Key=(Key-B+Key-A), Msg=(R-B+R-A))++++      Host A                                  Host B+      ------                                  ------+      MP_JOIN               ->+      [B's token, A's nonce,+       A's Address ID, flags]+                            <-                MP_JOIN+                                              [B's HMAC, B's nonce,+                                               B's Address ID, flags]+      ACK + MP_JOIN         ->+      [A's HMAC]++                            <-                ACK+++Introduction++* list the MPTCP connections in the pcap+* display some statistics on a specific MPTCP connection (list of subflows etc...);+* convert packet capture files (\*.pcap) to \*.csv files+* plot data sequence numbers for all subflows+* `XDG compliance <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>`_, i.e.,+  |prog| looks for files in certain directories. will try to load your configuration from `$XDG_CONFIG_HOME/mptcpanalyzer/config`+* caching mechanism: mptcpanalyzer compares your pcap creation time and will+  regenerate the cache if it exists in `$XDG_CACHE_HOME/mptcpanalyzer/<path_to_the_file>`+* support 3rd party plugins (plots or commands)++Most commands are self documented and/or with autocompletion.++Then you have an interpreter with autocompletion that can generate & display plots such as the following:++![Data Sequence Number (DSN) per subflow plot](examples/dsn.png)++* How to use++This package installs 2 programs:+- *mptcpanalyzer* to get details on a loaded pcap.+++mptcpanalyzer can run into 3 modes:+  1. :ref:`interactive-mode` (default): an interpreter with some basic completion will accept your commands.+  2. :ref:`batch-mode` if a filename is passed as argument, it will load commands from this file.+  3. :ref:`oneshot`, it will consider the unknow arguments as one command, the same that could be used interactively++For example, we can load an mptcp pcap (I made one available on `wireshark wiki+<https://wiki.wireshark.org/SampleCaptures#MPTCP>`_ or in this repository, in the _examples_ folder).++It expects a trace to work with. If the trace has the form *XXX.pcap* extension, the script will look for its csv counterpart *XXX.pcap.csv*. The program will tell you what arguments are needed. Then you can open the generated graphs.++++-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Main where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Commands+import MptcpAnalyzer.Commands.Definitions as CMD+import MptcpAnalyzer.Commands.Export as CLI+import MptcpAnalyzer.Commands.List as CLI+import MptcpAnalyzer.Commands.ListMptcp as CLI+import MptcpAnalyzer.Commands.Map as CLI+import qualified MptcpAnalyzer.Commands.Plot as Plots+import qualified MptcpAnalyzer.Commands.PlotOWD as Plots+import MptcpAnalyzer.Commands.Reinjections as CLI+import MptcpAnalyzer.Merge+import MptcpAnalyzer.Plots.Types+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+-- import qualified MptcpAnalyzer.Plots.Owd as Plots+import qualified MptcpAnalyzer.Commands.Load as CL+-- import Control.Monad (void)+import MptcpAnalyzer.Pcap (defaultParserOptions)+import MptcpAnalyzer.Utils.Completion+import MptcpAnalyzer.Utils.Text+import Tshark.Interfaces+import Tshark.Live+import Tshark.Main+       ( defaultTsharkOptions+       , defaultTsharkPrefs+       , genReadFilterFromTcpConnection+       , generateCsvCommand+       , tsharkReadFilter+       )+import Tshark.Sharkd+++-- hackage+import Control.Lens ((^.))+import qualified Data.Text as T+import Options.Applicative+import Options.Applicative.Common+import Options.Applicative.Help (parserHelp)+import Polysemy (Final, Members, Sem, runFinal)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import qualified Polysemy.IO as P+import qualified Polysemy.Internal as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.Log.Colog (interpretLogStdout)+import qualified Polysemy.State as P+import Polysemy.Trace (trace)+import qualified Polysemy.Trace as P+import Prelude hiding (concat, init, log)+import System.Directory+import System.FilePath+-- import Colog.Actions+import Graphics.Rendering.Chart.Backend.Cairo+       (FileFormat(..), FileOptions(..), renderableToFile, toFile)+import Graphics.Rendering.Chart.Renderable (toRenderable)+-- import           Graphics.Rendering.Chart.Easy          hiding (argument)+import qualified Data.Map as Map+import Graphics.Rendering.Chart.Layout (layout_title)+++-- for noCompletion+        -- <> Options.Applicative.value "/tmp"+-- import System.Posix.Signals -- installHandler+import Control.Lens (view, (^.))+import Control.Monad.State.Lazy (State, StateT, execStateT, get, put)+import Data.Either (fromLeft)+import Data.Foldable (forM_)+import Data.Maybe (catMaybes, fromMaybe)+import Distribution.Compat.Internal.TempFile (openTempFile)+import Distribution.Simple.Utils (withTempFileEx)+import Frames (Frame, Record, recMaybe)+import Frames as F+import Frames.CSV (writeDSV)+import Frames.InCore (toFrame)+import MptcpAnalyzer.Loader+import Pipes hiding (Proxy)+import System.Console.ANSI+import System.Console.Haskeline+import System.Exit+import System.Process hiding (runCommand)+import Data.List (isPrefixOf)+import Debug.Trace (traceShowId)+import GHC.Conc (forkIO)+import GHC.IO.Handle+import Options.Applicative.Builder (allPositional)+import Options.Applicative.Types+import System.IO (stderr, stdout)+import Tshark.Fields (TsharkFieldDesc(tfieldFullname), baseFields)+import MptcpAnalyzer.Plots.Live++data CLIArguments = CLIArguments {+  _input :: Maybe FilePath+  , version    :: Bool  -- ^ to show version+  , cacheDir    :: Maybe FilePath -- ^ Folder where to log files+  , logLevel :: Log.Severity   -- ^ what level to use to parse+  , extraCommands :: [String]  -- ^ commands to run on start+  }+++defaultImageOptions :: FileOptions+defaultImageOptions = FileOptions (800,600) PNG++loggerName :: String+loggerName = "main"++deriving instance Read Log.Severity++    -- <*> commandGroup "Loader commands"+    -- <> command "load-csv" CL.piLoadCsv++startupParser :: Parser CLIArguments+startupParser = CLIArguments+      <$> optional ( strOption+          ( long "load"+          <> short 'l'+         <> help "Either a pcap or a csv file (in good format).\+                 \When a pcap is passed, mptcpanalyzer will look for a its cached csv.\+                 \If it can't find one (or with the flag --regen), it will generate a \+                 \csv from the pcap with the external tshark program."+         <> metavar "INPUT_FILE" ))+      <*> switch (+          long "version"+          <> help "Show version"+          )+      <*> optional ( strOption+          ( long "cachedir"+         <> help "mptcpanalyzer creates a cache of files in the folder \+            \$XDG_CACHE_HOME/mptcpanalyzer"+         -- <> showDefault+         -- <> Options.Applicative.value "/tmp"+         <> metavar "CACHEDIR" ))+      <*> option auto+          ( long "log-level"+         <> help "Log level"+         <> showDefault+         <> Options.Applicative.value Log.Info+         <> metavar "LOG_LEVEL" )+      -- optional arguments+      <*> many ( argument str (+            metavar "COMMANDS..."+        ))+++opts :: ParserInfo CLIArguments+opts = info (startupParser <**> helper)+  ( fullDesc+  <> progDesc "Tool to provide insight in MPTCP (Multipath Transmission Control Protocol)\+              \performance via the generation of stats & plots"+  <> header "Type 'help' or '?' to list the available commands"+  -- <> footer "You can report issues/contribute at https://github.com/teto/mptcpanalyzer"+  )+++-- https://github.com/sdiehl/repline/issues/32++-- just for testing, to remove afterwards+defaultPcap :: FilePath+defaultPcap = "examples/client_2_filtered.pcapng"++        -- P.modify (\s -> s { _prompt = pcapFilename ++ "> ",+        --       _loadedFile = Just frame+        --     })+finalizePrompt :: String -> String+finalizePrompt newPrompt = setSGRCode [SetColor Foreground Vivid Red] ++ newPrompt ++ "> " ++ setSGRCode [Reset]++-- alternatively could modify defaultPrefs+-- subparserInline + multiSuffix helpShowGlobals+defaultParserPrefs :: ParserPrefs+defaultParserPrefs = (prefs $ showHelpOnEmpty <> showHelpOnError)+              {+                prefBacktrack = NoBacktrack+                }+++-- default if complete = completeFilename,+-- (String, String) -> m (String, [Completion])+customCompleteFunc :: CompletionFunc IO+customCompleteFunc = completeFilename+-- customCompleteFunc _i = return ("toto", [ Completion "toInsert" "choice 1" False ])++-- debugParser :: ArgumentReachability -> Option x -> String+-- debugParser reachability opt = case optMain opt of+--       OptReader ns _ _ -> "optreader"+--       FlagReader ns _ -> "flagReader"+--       ArgReader rdr -> "argreader"+--          -- >>= \x -> return $ Completion x "argreader help" True+--       CmdReader _ ns p -> "cmdreader"+++{-++Dont display anything before the call to execParser otherwise it gets printed in+the different shell completion scripts+-}+main :: IO ()+main = do++  cacheFolderXdg <- getXdgDirectory XdgCache "mptcpanalyzer2"+  -- Create cache if doesn't exist+  doesDirectoryExist cacheFolderXdg >>= \case+      -- TODO log it instead+      -- putStrLn ("cache folder already exists" ++ show cacheFolderXdg)+      True -> return ()+      False -> createDirectory cacheFolderXdg++  let myState = MyState {+      _stateCacheFolder = cacheFolderXdg+    , _loadedFile = Nothing+    , _prompt = finalizePrompt ">"+    , _sharkdHandle = Nothing+  }++  options <- execParser opts++  putStrLn "Commands:"+  print $ extraCommands options++  let haskelineSettings = (Settings {+      complete = generateHaskelineCompleterFromParserInfo defaultParserPrefs mainParserInfo+      , historyFile = Just $ cacheFolderXdg </> "history"+      , autoAddHistory = True+      })+  let+    cacheConfig :: CacheConfig+    cacheConfig = CacheConfig {+      cacheFolder = cacheFolderXdg+      , cacheEnabled = True+    }++  _ <- runInputT haskelineSettings $+          runFinal @(InputT IO)+          $ P.embedToFinal . P.runEmbedded lift+          $ P.traceToStdout+          $ P.runState myState+          $ runCache cacheConfig+          $ interpretLogStdout+            (inputLoop (extraCommands options))+++  -- TODO when the process is not nothing+  -- withProcessHandle (_sharkdHandle myState) $ \ph_ ->+  --   case ph_ of+  --     OpenHandle pid -> signalProcess sigKILL pid+  --     ClosedHandle _ -> return ()                   -- shouldn't happen+  return ()+++-- TODO move+++piListInterfaces :: ParserInfo CommandArgs+piListInterfaces = info (pure ArgsListInterfaces)+  ( fullDesc+  <> progDesc "List interfaces as seen by tshark"+  <> footer "Example: load-pcap examples/client_2_filtered.pcapng"+  <> forwardOptions+  )++-- |Global parser: contains every available command+-- TODO for some commands we could factorize the preprocessing eg check a file+-- was pre-loaded+-- aka check the if loadedFile was loaded+-- one can create groups with <|> subparser+mainParser :: Parser CommandArgs+mainParser = subparser (+    commandGroup "Generic"+    -- <> command "help" helpParser+    <> command "quit" quit+    -- <> commandGroup "Loader commands"+    <> command "load-csv" CL.piLoadCsv+    <> command "load-pcap" CL.piLoadPcapOpts+    <> commandGroup "TCP commands"+    <> command "tcp-summary" CLI.piTcpSummaryOpts+    <> command "mptcp-summary" CLI.piMptcpSummaryOpts+    <> command "list-tcp" CLI.piListTcpOpts+    <> command "list-tcp-from-file" piListFromFile+    <> command "map-tcp" CLI.mapTcpOpts+    <> command "map-mptcp" CLI.mapMptcpOpts+    <> commandGroup "MPTCP commands"+    <> command "list-reinjections" CLI.piListReinjections+    <> command "list-mptcp" CLI.piListMpTcpOpts+    <> command "list-interfaces" piListInterfaces+    <> command "export" CLI.piExportOpts+    <> command "analyze" CLI.piQualifyReinjections+    <> commandGroup "TCP plots"+    -- TODO here we should pass a subparser+    -- <> subparser (+    -- Main.piParserGeneric+    <> command "plot-tcp" ( info Plots.parserPlotTcpMain (progDesc "Plot One-Way-Delays (also called One-Time-Trips)"))+    <> command "plot-mptcp" ( info Plots.parserPlotMptcpMain (progDesc "Multipath-tcp plots"))+    <> command "plot-tcp-live" ( info Plots.parserPlotTcpLive (progDesc "TCP Live plots"))+    <> command "plot-mptcp-live" ( info Plots.parserPlotMptcpLive (progDesc "MPTCP Live plots"))+    )+    where+      helpParser = info (pure ArgsHelp) (progDesc "Display help")+      quit = info (pure ArgsQuit) (progDesc "Quit mptcpanalyzer")+      piListFromFile = info (+            ArgsTcpSummaryFromFile <$>+            argument filenameReader (metavar "PCAP"+              <> completer completePath+              <> help "Load a Pcap file"+            ))+          ( fullDesc+            <> progDesc "Load a pcap file via wireshark"+            <> footer "Example: load-pcap examples/client_2_filtered.pcapng"+            <> allPositional+            )++++-- |Main parser+mainParserInfo :: ParserInfo CommandArgs+-- mainParserInfo = info (mainParser <**> helper)+mainParserInfo = info mainParser+  ( fullDesc+  <> allPositional+  <> progDesc "Tool to provide insight in MPTCP (Multipath Transmission Control Protocol)\+              \performance via the generation of stats & plots"+  <> header "hello - a test for optparse-applicative"+  <> footer "You can report issues/contribute at https://github.com/teto/mptcpanalyzer"+  -- <> noIntersperse+  -- <> forwardOptions+  )+++cmdListInterfaces :: (Members '[+  Log, Cache,+  P.Trace, P.State MyState,+  P.Embed IO+  ] r) => Sem r CMD.RetCode+cmdListInterfaces = do+  (exitCode, ifs) <- P.embed listInterfaces++  trace "Listing interfaces:"+  trace $ "ifs" ++ concatMap (\x -> x ++ "\n") ifs+  return CMD.Continue+++runCommand :: (Members '[Log, Cache, P.Trace, P.State MyState, P.Embed IO] r)+  => CommandArgs -> Sem r CMD.RetCode++runCommand (ArgsLoadPcap fileToLoad) = loadPcap fileToLoad+  -- ret <- CL.loadPcap fileToLoad+  -- TODO modify only on success+  -- P.modify (\s -> s { _prompt = pcapFilename ++ "> ",+  --       _loadedFile = Just frame+  --     })+  -- return ret+runCommand (ArgsLoadCsv csvFile _) = CL.cmdLoadCsv csvFile+runCommand (ArgsTcpSummary detailed streamId) = CLI.cmdTcpSummary streamId detailed+runCommand (ArgsTcpSummaryFromFile filepath ) = CLI.cmdTcpSummarySharkd filepath (StreamId 0) False+runCommand (ArgsMptcpSummary detailed streamId) = CLI.cmdMptcpSummary streamId detailed+runCommand (ArgsListSubflows detailed) = CLI.cmdListSubflows detailed+runCommand (ArgsListReinjections streamId)  = CLI.cmdListReinjections streamId+runCommand (ArgsListTcpConnections detailed) = CLI.cmdListTcpConnections detailed+runCommand (ArgsListMpTcpConnections detailed) = CLI.cmdListMptcpConnections detailed+runCommand ArgsListInterfaces = cmdListInterfaces+runCommand (ArgsExport out) = CLI.cmdExport out+runCommand (ArgsPlotGeneric plotSettings plotArgs) = runPlotCommand plotSettings plotArgs+runCommand (ArgsMapTcpConnections cmd False) = CLI.cmdMapTcpConnection cmd+runCommand (ArgsMapTcpConnections args True) = CLI.cmdMapMptcpConnection args+runCommand (ArgsQualifyReinjections mapping verbose) = CLI.cmdQualifyReinjections mapping [RoleServer] verbose+runCommand ArgsQuit = cmdQuit+runCommand ArgsHelp = cmdHelp++-- TODO move commands to their own module+-- TODO it should update the loadedFile in State !+loadPcap :: (Members '[Log, P.State MyState, Cache, P.Embed IO] r)+  => FilePath -- ^ File to load+  -> Sem r RetCode+loadPcap pcapFilename = do+    Log.info $ "loading pcap " <> tshow pcapFilename+    mFrame <- loadPcapIntoFrame defaultTsharkPrefs pcapFilename+    -- fmap onSuccess mFrame+    case mFrame of+      Left _ -> return CMD.Continue+      Right frame -> do+        P.modify (\s -> s {+            _prompt = finalizePrompt pcapFilename,+            _loadedFile = Just frame+          })+        Log.info "Frame loaded" >> return CMD.Continue++-- | Quits the program+cmdQuit :: Members '[P.Trace] r => Sem r CMD.RetCode+cmdQuit = trace "Thanks for flying with mptcpanalyzer" >> return CMD.Exit++-- | Prints the help when requested+cmdHelp :: Members '[P.Trace, P.State MyState] r => Sem r CMD.RetCode+cmdHelp = do+  -- TODO display help / use trace instead+  trace $ show $ parserHelp defaultParserPrefs mainParser+  return CMD.Continue++-- |Command specific to plots+-- TODO these should return a plot instead of a generated file so that one can overwrite the title+-- also this should be moved somewhere else+runPlotCommand :: (Members '[Log, Cache, P.Trace, P.State MyState, P.Embed IO] r)+  => PlotSettings -> ArgsPlots+  -> Sem r CMD.RetCode+runPlotCommand (PlotSettings mbOut _mbTitle displayPlot mptcpPlot) specificArgs = do+    (tempPath, handle) <- P.embed $ openTempFile "/tmp" "plot.png"+    _ <- case specificArgs of+      (ArgsPlotTcpAttr pcapFilename streamId attr mbDest) -> do+        let destinations = getDests mbDest+        Log.debug $ "MPTCP plot" <> tshow mptcpPlot++        res <- if mptcpPlot then do+              eFrame <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcapFilename (StreamId streamId)+              case eFrame of+                Left err -> return $ CMD.Error err+                Right frame -> Plots.cmdPlotMptcpAttribute attr tempPath destinations frame++            else do+              eFrame <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcapFilename (StreamId streamId)+              case eFrame of+                Left err -> return $ CMD.Error err+                Right frame -> do+                  l <- Plots.cmdPlotTcpAttribute attr destinations frame+                  -- toRenderable+                  P.embed $ toFile defaultImageOptions tempPath l+                  -- embed $ void $ renderableToFile defaultImageOptions tempPath (toRenderable l)+                      -- layout_title .= "TCP " ++ attr+                      -- l+                  return CMD.Continue+        return res++      -- Destinations+      (ArgsPlotOwdTcp mapping dest) ->+        -- Log.info $ "plotting owd for tcp.stream " <> tshow streamId1 <> " and " <> tshow streamId2+        Plots.cmdPlotTcpOwd tempPath handle (getDests dest) mapping++      (ArgsPlotOwdMptcp (PcapMapping pcap1 streamId1 pcap2 streamId2) dest) -> do+        Log.info "plotting mptcp owd"+        eframe1 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap1 streamId1+        eframe2 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap2 streamId2++        case (eframe1, eframe2 ) of+          (Right aframe1, Right aframe2) -> do+              mergedRes <- mergeMptcpConnectionsFromKnownStreams aframe1 aframe2+              -- let mbRecs = map recMaybe mergedRes+              -- let justRecs = catMaybes mbRecs+              -- Plots.cmdPlotMptcpOwd tempPath handle (getDests dest) (ffCon aframe1) mergedRes+              error "not implemented"+          (Left err, _) -> return $ CMD.Error err+          (_, Left err) -> return $ CMD.Error err++      -- Starts livestatistics on a connection+      ArgsPlotLiveTcp livePlotSettings  -> +        configureLivePlotTcp livePlotSettings >> return CMD.Continue++      ArgsPlotLiveMptcp livePlotSettings -> do+        Log.info $ "Looking at destination "+        configureLivePlotMptcp livePlotSettings >> return CMD.Continue++    P.embed $ forM_ mbOut (renameFile tempPath)+    -- _ <- P.embed $ case mbOut of+    --         -- user specified a file move the file+    --         Just outFilename -> renameFile tempPath outFilename+    --         Nothing -> return ()+    if displayPlot then do+        let+          createProc :: CreateProcess+          -- for some reason it recognizes the image as application/octet-stream+          -- and I can't manage to make it use my image/png application+          createProc = (proc "xdg-open" [ tempPath ]) {+          -- createProc = (proc "sxiv" [ tempPath ]) {+              delegate_ctlc = True+              }++        Log.info $ "Launching " <> tshow createProc+        (_, _, mbHerr, ph) <- P.embed $ createProcess createProc+        exitCode <- P.embed $ waitForProcess ph+        return Continue++    else+      return Continue+    where+      getDests mbDest = maybe [RoleClient, RoleServer] (: []) mbDest++++-- TODO use genericRunCommand+runIteration :: (Members '[Log, Cache, P.Trace, P.State MyState, P.Embed IO] r)+  => Maybe String+  -> Sem r CMD.RetCode+runIteration fullCmd = do+    cmdCode <- case fmap Prelude.words fullCmd of+        Nothing -> do+          trace "please enter a valid command, see help"+          return CMD.Continue+        Just args -> do+          -- TODO parse+          Log.info $ "Running " <> tshow args+          let parserResult = execParserPure defaultParserPrefs mainParserInfo args+          case parserResult of+            -- Failure (ParserFailure ParserHelp)+            (Failure failure) -> do+                -- last arg is progname+                let (h, exit) = renderFailure failure ""+                -- Log.debug h+                P.trace h+                Log.debug $ "Exit code " <> tshow exit+                Log.debug $ "Passed args " <> tshow args+                return $ case exit of+                    ExitSuccess -> CMD.Continue+                    ExitFailure _exitCode -> CMD.Error $ "could not parse: " ++ show failure+            (CompletionInvoked _compl) -> return CMD.Continue+            (Success parsedArgs) -> runCommand parsedArgs++    case cmdCode of+        CMD.Exit -> P.trace "Exiting" >> return CMD.Exit+        CMD.Error msg -> do+          P.trace $ "CmdCode: Last command failed with message:\n" ++ show msg+          return $ CMD.Error msg+        behavior -> return behavior++-- | Main loop of the program, will run commands in turn+inputLoop :: (Members '[Log , Cache, P.Trace, P.State MyState, P.Embed IO, P.Final (InputT IO)] r)+    => [String] -> Sem r ()+inputLoop = go+  where+    go :: (Members '[Log, Cache, P.Trace, P.State MyState, P.Embed IO, P.Final (InputT IO)] r)+      => [String] -> Sem r ()+    go (xs:rest) = runIteration (Just xs) >>= \case+        CMD.Exit -> trace "Exiting"+        _ -> do+          inputLoop rest+    go [] = do+      s <- P.get+      minput <- P.embedFinal $ getInputLine (view prompt s)+      runIteration minput >>= \case+        CMD.Exit -> trace "Exiting"+        -- _ -> pure ()+        _ -> inputLoop []+
+ tests/MptcpAnalyzer/LoaderSpec.hs view
@@ -0,0 +1,27 @@+module MptcpAnalyzer.LoaderSpec (+spec+) where+-- import           Test.Tasty+-- import           Test.Tasty.HUnit+import Data.Maybe (fromJust)+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import Net.IP+import Net.IPv4 (localhost)+import Net.Tcp.Connection+import System.Exit (ExitCode(ExitSuccess))+import System.IO+import Test.Hspec+import Test.QuickCheck hiding (Success)+import Tshark.Main++++-- TODO test (nombre de paquets par exemple ?)+-- buildAFrameFromStreamIdTcp+spec :: Spec+spec = describe "Checking pcap loader" $ do+  it "test" $+    pendingWith "test"
+ tests/MptcpAnalyzer/MapSpec.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ScopedTypeVariables #-}+module MptcpAnalyzer.MapSpec (+spec+) where+-- import           Test.Tasty+-- import           Test.Tasty.HUnit+import Data.Maybe (fromJust)+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import Net.IP+import Net.IPv4 (localhost)+import Net.Tcp.Connection+import Polysemy (Final, Members, Sem, runFinal)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import qualified Polysemy.IO as P+import qualified Polysemy.Internal as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.Log.Colog (interpretLogStdout)+import System.Exit (ExitCode(ExitSuccess))+import System.IO+import Test.Hspec+import Test.QuickCheck hiding (Success)+import Tshark.Main++import Data.Either (fromRight)+import Frames.Frame (Frame)+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Cache+import MptcpAnalyzer.Loader (loadPcapIntoFrame)+import MptcpAnalyzer.Map+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import Utils++cacheConfig :: CacheConfig+cacheConfig = CacheConfig {+  cacheFolder = "/tmp"+  , cacheEnabled = False+}+++loadTestFrames :: IO (FrameFiltered TcpConnection Packet, Frame Packet)+loadTestFrames = do++  aframes <- P.runM+    $ interpretLogStdout+    $ runCache cacheConfig+      runTests+  return aframes+++runTests :: (Members '[P.Embed IO, Log, Cache] r) => Sem r (FrameFiltered TcpConnection Packet, Frame Packet)+runTests = do+  -- :: Either String (Frame Packet)+  eFrame1 <- loadPcapIntoFrame defaultTsharkPrefs "examples/client_2_cleaned.pcapng"+  eFrame2 <- loadPcapIntoFrame defaultTsharkPrefs "examples/server_2_cleaned.pcapng"++  frame2 <- case eFrame2 of+    Left err -> error err+    Right frame -> return frame++  (aframe :: FrameFiltered TcpConnection Packet) <- case buildFrameFromStreamId (fromRight (error "should not happen") eFrame1) (StreamId 0) of+    Left err -> error err+    Right aframe -> return aframe++  return (aframe, frame2)++-- TODO this should be part of a golden test with tasty instead+expectedMappings = [+  (TcpConnection {conTcpClientIp = ipv4 10 0 0 1, conTcpServerIp = ipv4 10 0 0 2, conTcpClientPort = 33782, conTcpServerPort = 5201, conTcpStreamId = StreamId 0},40)+  ,(TcpConnection {conTcpClientIp = ipv4 10 0 0 1, conTcpServerIp = ipv4 10 0 0 2, conTcpClientPort = 33784, conTcpServerPort = 5201, conTcpStreamId = StreamId 1},30)+  ,(TcpConnection {conTcpClientIp = ipv4 10 0 0 1, conTcpServerIp = ipv4 11 0 0 2, conTcpClientPort = 54595, conTcpServerPort = 5201, conTcpStreamId = StreamId 2},20)+  ,(TcpConnection {conTcpClientIp = ipv4 10 0 0 1, conTcpServerIp = ipv4 11 0 0 2, conTcpClientPort = 57491, conTcpServerPort = 5201, conTcpStreamId = StreamId 3},20)+  ,(TcpConnection {conTcpClientIp = ipv4 11 0 0 1, conTcpServerIp = ipv4 10 0 0 2, conTcpClientPort = 35589, conTcpServerPort = 5201, conTcpStreamId = StreamId 6},20)+  ,(TcpConnection {conTcpClientIp = ipv4 11 0 0 1, conTcpServerIp = ipv4 10 0 0 2, conTcpClientPort = 50007, conTcpServerPort = 5201, conTcpStreamId = StreamId 7},20)+  ,(TcpConnection {conTcpClientIp = ipv4 11 0 0 1, conTcpServerIp = ipv4 11 0 0 2, conTcpClientPort = 50077, conTcpServerPort = 5201, conTcpStreamId = StreamId 5},10)]++spec :: Spec+spec = describe "Checking connection mapper" $ do+  before loadTestFrames $ it "test" $ \(aframe, frame1) ->+    mapTcpConnection aframe frame1 `shouldBe` expectedMappings+    -- pendingWith "test"+  -- TODO check+  -- mapTcpConnection+
+ tests/MptcpAnalyzer/PcapSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module MptcpAnalyzer.PcapSpec (+spec+) where+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import Net.IP+import Net.IPv4 (localhost)+import Net.Tcp.Connection+import Test.Hspec+import Data.Maybe (fromJust)+import MptcpAnalyzer.ArtificialFields+import Utils+import qualified Data.Foldable as F+import MptcpAnalyzer.Types+import Distribution.Compat.Lens (view)+-- import Control.Lens+++exampleTcpConnectionLocalhost :: TcpConnection+exampleTcpConnectionLocalhost = TcpConnection (fromIPv4 localhost) (fromIPv4 localhost) 24 42 (StreamId 0)++exampleTcpConnection0 :: TcpConnection+exampleTcpConnection0 = TcpConnection (fromJust $ decode "10.0.0.1") (fromJust $ decode "192.10.0.2") 24 42 (StreamId 1)+++-- addTcpDestinationsToAFrame+-- genTcpDestFrame++spec :: Spec+spec = describe "absolute" $ do+  it "Check TcpConnection score" $+    scoreTcpCon exampleTcpConnectionLocalhost exampleTcpConnection0 < scoreTcpCon exampleTcpConnectionLocalhost exampleTcpConnectionLocalhost+  before (loadAFrame "examples/client_2_cleaned.pcapng" (StreamId 0)) $ it "Check that destinations are set correctly" $ \aframe ->+    length (genTcpDestFrameFromAFrame aframe) == (length $ ffFrame aframe)+  before (loadAFrame "examples/client_2_cleaned.pcapng" (StreamId 0)) $ it "Check that destinations are set correctly" $ \aframe ->+    let+      tcpdestFrame = genTcpDestFrameFromAFrame aframe+      tcpDests = F.toList $ view tcpDest <$> tcpdestFrame+      -- clientFrame = filterFrame (\x -> x ^. tcpDest == RoleClient) tcpdestFrame+    in+      length (filter ((==) RoleServer) tcpDests) `shouldBe` 16+      -- length (ffFrame aframe) `shouldBe` (length $ clientFrame)+    -- it "Generate the correct tshark filter" $+--       genReadFilterFromTcpConnection exampleTcpConnection0 (Just RoleClient)+--         `shouldBe` "tcp and ip.addr==127.0.0.1 and ip.addr==127.0.0.1 and tcp.srcport==42 and tcp.dstport==24"+--       -- exportToCsv "mptcpanalyzer/examples/client_2_filtered.pcapng"+--     it "Tshark generates a proper CSV file" $ do+--       -- cant find the profile so there is some herr being written+--       withFile "/tmp/mptcp.csv" ReadWriteMode (exportToCsv defaultTsharkPrefs "examples/client_2_filtered.pcapng") >>= \x -> fst x `shouldBe` ( ExitSuccess)+--       -- `shouldThrow`+--     it "Test frame loading" $+--       pendingWith "test"
+ tests/Net/Tcp/StatsSpec.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-+Module:  StatsSpec+Description :  Description+Maintainer  : matt+Portability : Linux++Load a pcap in chunks and check that it produces the same result+-}+module Net.Tcp.StatsSpec (+  spec+) where+import Frames.Exploration+-- import MptcpAnalyzer.Loader+import MptcpAnalyzer.Pcap+import Test.Hspec+-- import Test.QuickCheck hiding (Success)++-- import Data.Either (fromRight)+-- import Frames+import MptcpAnalyzer.ArtificialFields+-- import MptcpAnalyzer.Cache+-- import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import Net.Tcp+import Net.Tcp.Stats+-- import Polysemy (Final, Members, Sem, runFinal)+-- import qualified Polysemy as P+-- import qualified Polysemy.Embed as P+-- import qualified Polysemy.IO as P+-- import qualified Polysemy.Internal as P+-- import Polysemy.Log (Log)+-- import qualified Polysemy.Log as Log+-- import Polysemy.Log.Colog (interpretLogStdout)+-- import qualified Polysemy.State as P+-- import qualified Polysemy.Trace as P+-- import Tshark.Main (defaultTsharkPrefs)+import Utils+import Data.Foldable (foldl')+import Net.Stream++-- cacheConfig :: CacheConfig+-- cacheConfig = CacheConfig {+--   cacheFolder = "/tmp"+--   , cacheEnabled = False+-- }++expectedForwardStats, expectedForwardStats0, expectedForwardStats1 :: TcpUnidirectionalStats+expectedBackwardStats, expectedBackwardStats0, expectedForwardStatsTotal01  :: TcpUnidirectionalStats+expectedForwardStats = mempty+expectedBackwardStats = mempty+expectedForwardStats0 = TcpUnidirectionalStats {tusNrPackets = 16, tusStartTime = 0.0, tusEndTime = 45.831181697, tusMinSeq = 0, tusSndUna = 457, tusSndNext = 457, tusReinjectedBytes = 0}+expectedForwardStats1 = mempty+expectedBackwardStats0 = TcpUnidirectionalStats {tusNrPackets = 13, tusStartTime = 0.184116349, tusEndTime = 45.842675096, tusMinSeq = 0, tusSndUna = 309, tusSndNext = 309, tusReinjectedBytes = 0}+expectedForwardStatsTotal01 = mempty++-- TcpUnidirectionalStats {+--       tusStartPacketId = 0 -- (frameRow frame 0) ^. packetId+--       , tusEndPacketId = 0 -- (frameRow frame (frameLength frame - 1)) ^. packetId+--       , tusNrPackets = frameLength frame+--       , tusStartTime = minTime+--       , tusEndTime = maxTime+--       -- TODO fill it+--       , tusMinSeq = minSeq++--       -- TODO should be max of seen acks+--       , tusSndUna = maxSeqRow ^. tcpSeq + fromIntegral ( maxSeqRow ^. tcpLen) :: Word32+--       , tusSndNext = maxSeqRow ^. tcpSeq + fromIntegral ( maxSeqRow ^. tcpLen ) :: Word32+--       , tusReinjectedBytes = 0+--   }++-- loadAFrame :: IO (FrameFiltered TcpConnection Packet)+-- loadAFrame = do++--   aframe <- P.runM+--     $ interpretLogStdout+--     $ runCache cacheConfig+--       runTests+--   return aframe+--   putStrLn "finished"+++++-- runTests :: (Members '[P.Embed IO, Log , Cache] r) => Sem r (FrameFiltered TcpConnection Packet)+-- runTests = do+--   -- :: Either String (Frame Packet)+--   frame1 <- loadPcapIntoFrame defaultTsharkPrefs "examples/client_2_cleaned.pcapng"++--   (aframe :: FrameFiltered TcpConnection Packet) <- case buildFrameFromStreamId (fromRight (error "should not happen") frame1) (StreamId 0) of+--     Left err -> error err+--     Right aframe -> return aframe++--   return aframe++  -- TODO run hspec and check FrameLength is the same ?+  -- check stats over the whole file+  -- P.embed $ hspec $+++expectedStats :: TcpUnidirectionalStats+-- expectedStats = mempty+expectedStats = TcpUnidirectionalStats {tusNrPackets = 13, tusStartTime = 0.0, tusEndTime = 45.842675096, tusMinSeq = 0, tusSndUna = 0, tusSndNext = 0, tusReinjectedBytes = 0}++splitAFrame :: FrameFiltered TcpConnection Packet -> Int -> [FrameFiltered TcpConnection Packet]+splitAFrame aframe chunkSize  =+  -- takeRows / dropRow+  go aframe []+  where+    go aframe' acc = if aframeLength aframe' < chunkSize then+        acc ++ [aframe']+      else+        go (FrameTcp (ffCon aframe') (dropRows chunkSize $ ffFrame aframe'))+           acc ++ [(FrameTcp (ffCon aframe') (takeRows chunkSize $ ffFrame aframe'))]++++-- beforeWith (loadAFrame) $+-- before loadAFrame $ describ+spec :: Spec+spec = before (loadAFrame "examples/client_2_cleaned.pcapng" (StreamId 0)) $+      describe "Checking stats" $ do+        it "Check generated forward stats" $ \aframe ->+          getTcpStatsFromAFrame (addTcpDestinationsToAFrame aframe) RoleServer `shouldBe` expectedForwardStats0+        it "Check generated backwards stats" $ \aframe ->+          getTcpStatsFromAFrame (addTcpDestinationsToAFrame aframe) RoleClient `shouldBe` expectedBackwardStats0++        it "Processing stats in chunks equal processing the full batch" $ \aframe -> let +            chunks = splitAFrame aframe 2+          in+            foldl' (\origStats newAframe -> origStats <> getTcpStatsFromAFrame (addTcpDestinationsToAFrame newAframe) RoleClient ) mempty chunks `shouldBe` expectedStats++        -- it "Checking two crafted stats" $ \aframe -> let ++  -- it "Test append of stats" $+  --     expectedForwardStats0head <> expectedForwardStats0tail `shouldBe` expectedForwardStats0+  -- pendingWith "test"+
+ tests/Spec.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+-- https://hspec.github.io/hspec-discover.html+import qualified Spec+import Test.Hspec.Formatters+import Test.Hspec.Runner++main :: IO ()+main = hspecWith defaultConfig {configFormatter = Just progress} Spec.spec
+ tests/Tshark/MainSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+module Tshark.MainSpec (spec)+where+import Data.Maybe (fromJust)+import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)+import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import Net.IP+import Net.IPv4 (localhost)+import Net.Tcp.Connection+import System.Exit (ExitCode(ExitSuccess))+import System.IO+import Test.Hspec+import Test.QuickCheck hiding (Success)+import Tshark.Main++++exampleTcpConnectionLocalhost :: TcpConnection+exampleTcpConnectionLocalhost = TcpConnection (fromIPv4 localhost) (fromIPv4 localhost) 24 42 (StreamId 0)++exampleTcpConnection0 :: TcpConnection+exampleTcpConnection0 = TcpConnection (fromJust $ decode "10.0.0.1") (fromJust $ decode "192.10.0.2") 24 42 (StreamId 1)++opts :: TempFileOptions+opts = TempFileOptions True++-- main :: IO ()+-- main = hspec $ do+spec :: Spec+spec =+  describe "tshark tests" $ do+    it "Generate bidirectional tshark filter" $+      genReadFilterFromTcpConnection exampleTcpConnectionLocalhost Nothing+        `shouldBe` "tcp and ip.addr==127.0.0.1 and ip.addr==127.0.0.1 and tcp.port==42 and tcp.port==24"+    it "Check the unidirectional filter" $+      genReadFilterFromTcpConnection exampleTcpConnection0 (Just RoleClient)+        `shouldBe` "tcp and ip.src==10.0.0.1 and ip.dst==192.10.0.2 and tcp.srcport==24 and tcp.dstport==42"+      -- exportToCsv "mptcpanalyzer/examples/client_2_filtered.pcapng"+    it "Tshark generates a proper CSV file" $ do+      -- cant find the profile so there is some herr being written+      withFile "/tmp/mptcp.csv" ReadWriteMode (exportToCsv defaultTsharkPrefs "examples/client_2_filtered.pcapng") >>= \x -> fst x `shouldBe` ( ExitSuccess)++      -- `shouldThrow`+    it "Test frame loading" $+      pendingWith "test"+
+ tests/Utils.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Utils (+  loadAFrame+  -- , loadPcapIntoFrameNoCache+)+where++import MptcpAnalyzer.ArtificialFields+import MptcpAnalyzer.Pcap+import MptcpAnalyzer.Stream+import MptcpAnalyzer.Types+import qualified MptcpAnalyzer.Utils.Text as T+import Net.Tcp.Connection+import Tshark.Main++import Control.Monad.IO.Class (liftIO)+import Data.Either (fromRight)+import Distribution.Simple.Utils+import Frames (ColumnHeaders, ElField, FrameRec)+import qualified Frames.CSV+import qualified Frames.InCore+import MptcpAnalyzer.Cache (CacheConfig(..))+import MptcpAnalyzer.Loader (loadPcapIntoFrame, loadPcapIntoFrameNoCache)+import Polysemy (Final, Members, Sem, runFinal)+import qualified Polysemy as P+import qualified Polysemy.Embed as P+import qualified Polysemy.IO as P+import qualified Polysemy.Internal as P+import Polysemy.Log (Log)+import qualified Polysemy.Log as Log+import Polysemy.Log.Colog (interpretLogStdout)+import System.Exit+cacheDisabledConfig :: CacheConfig+cacheDisabledConfig = CacheConfig {+  cacheFolder = "/tmp"+  , cacheEnabled = False+}++-- loadAFrame :: IO (FrameFiltered TcpConnection Packet)+-- loadAFrame = do++--   aframe <- P.runM+--     $ interpretLogStdout+--     $ runCache cacheDisabledConfig+--       runTests+--   return aframe+--   putStrLn "finished"++-- loadAFrame+--   (aframe :: FrameFiltered TcpConnection Packet) <- case buildFrameFromStreamId (fromRight (error "should not happen") eFrame1) (StreamId 0) of+--     Left err -> error err+--     Right aframe -> return aframe+++loadAFrame :: FilePath -> StreamId Tcp -> IO (FrameFiltered TcpConnection Packet)+loadAFrame = loadAFrameWithOpts defaultTsharkPrefs++loadAFrameWithOpts :: TsharkParams -> FilePath -> StreamId Tcp -> IO (FrameFiltered TcpConnection Packet)+loadAFrameWithOpts tsharkParams path streamId = do+  frame1 <- loadPcapIntoFrameNoCache tsharkParams path++  (aframe :: FrameFiltered TcpConnection Packet) <- case buildFrameFromStreamId (fromRight (error "should not happen") frame1) streamId of+    Left err -> error err+    Right aframe -> return aframe++  return aframe++-- runTests :: (Members '[P.Embed IO, Log, Cache] r) => Sem r (FrameFiltered TcpConnection Packet)+-- runTests = do+--   -- :: Either String (Frame Packet)+--   frame1 <- loadPcapIntoFrame defaultTsharkPrefs "examples/client_2_cleaned.pcapng"++--   (aframe :: FrameFiltered TcpConnection Packet) <- case buildFrameFromStreamId (fromRight (error "should not happen") frame1) (StreamId 0) of+--     Left err -> error err+--     Right aframe -> return aframe++--   return aframe+
+ tests/integration/list-tcp.test view
@@ -0,0 +1,24 @@+cabal run mptcpanalyzer "load-pcap examples/client_2_filtered.pcapng" "quit"+<<<+>>>+Up to date+cache folder already exists"/home/teto/.cache/mptcpanalyzer2"+Commands+["load-pcap examples/client_2_filtered.pcapng","quit"]+loading pcap examples/client_2_filtered.pcapng+Start loading pcap examples/client_2_filtered.pcapng+getCache error: Not implemented yet+Calling tshark++loading pcap examples/client_2_filtered.pcapng+Start loading pcap examples/client_2_filtered.pcapng+getCache error: Not implemented yet+Calling tshark+Exporting fields ["frame.number","frame.interface_name","frame.time_epoch","frame.time_relative","_ws.col.ipsrc","_ws.col.ipdst","ip.src_host","ip.dst_host","tcp.stream","tcp.srcport","tcp.dstport","tcp.window_size","tcp.flags","tcp.option_kind","tcp.seq","tcp.len","tcp.ack","tcp.options.timestamp.tsval","tcp.options.timestamp.tsecr","mptcp.expected_token","mptcp.stream","tcp.options.mptcp.sendkey","tcp.options.mptcp.recvkey","tcp.options.mptcp.recvtok","tcp.options.mptcp.datafin.flag","tcp.options.mptcp.version","mptcp.ack","mptcp.dsn"]+Command run: RawCommand "tshark" ["-r","examples/client_2_filtered.pcapng","-E","separator=|","-o","mptcp.analyze_mptcp:true","-o","mptcp.intersubflows_retransmission:true","-o","mptcp.relative_sequence_numbers:true","-o","mptcp.analyze_mappings:true","-o","tcp.analyze_sequence_numbers:true","-o","gui.column.format:Time,%At,ipsrc,%s,ipdst,%d","-2","-R","mptcp or tcp and not icmp","-T","fields","-e","frame.number","-e","frame.interface_name","-e","frame.time_epoch","-e","frame.time_relative","-e","_ws.col.ipsrc","-e","_ws.col.ipdst","-e","ip.src_host","-e","ip.dst_host","-e","tcp.stream","-e","tcp.srcport","-e","tcp.dstport","-e","tcp.window_size","-e","tcp.flags","-e","tcp.option_kind","-e","tcp.seq","-e","tcp.len","-e","tcp.ack","-e","tcp.options.timestamp.tsval","-e","tcp.options.timestamp.tsecr","-e","mptcp.expected_token","-e","mptcp.stream","-e","tcp.options.mptcp.sendkey","-e","tcp.options.mptcp.recvkey","-e","tcp.options.mptcp.recvtok","-e","tcp.options.mptcp.datafin.flag","-e","tcp.options.mptcp.version","-e","mptcp.ack","-e","mptcp.dsn"]+exported to file /tmp/mptcp31108-0.csv+Number of rows after loading 4164+Saved into cache+Frame loaded+>>>2+>>>= 0