asakul
/
pontarius-xmpp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

initial import, copy of darcs repository

master
Jon Kristensen 15 years ago
commit
5e0bee18c5
20 changed files with 6126 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 674
      COPYING
  2. 165
      COPYING.LESSER
  3. 536
      Documentation/Pontarius XMPP Manual.lyx
  4. 192
      Documentation/Software Design Description for Pontarius XMPP 1.0.lyx
  5. 324
      Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx
  6. 1459
      Documentation/Software Requirements Specification for Pontarius XMPP.lyx
  7. 147
      Examples/EchoClient.hs
  8. 4
      LICENSE
  9. 106
      Network/XMPP.hs
  10. 216
      Network/XMPP/Address.hs
  11. 215
      Network/XMPP/SASL.hs
  12. 758
      Network/XMPP/Session.hs
  13. 182
      Network/XMPP/Stanza.hs
  14. 457
      Network/XMPP/Stream.hs
  15. 47
      Network/XMPP/TLS.hs
  16. 457
      Network/XMPP/Types.hs
  17. 93
      Network/XMPP/Utilities.hs
  18. 22
      README
  19. 3
      Setup.hs
  20. 69
      pontarius-xmpp.cabal

674
COPYING
Unescape View File

@ -0,0 +1,674 @@ @@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.

165
COPYING.LESSER
Unescape View File

@ -0,0 +1,165 @@ @@ -0,0 +1,165 @@
GNU LESSER 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.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.

536
Documentation/Pontarius XMPP Manual.lyx
Unescape View File

@ -0,0 +1,536 @@ @@ -0,0 +1,536 @@
#LyX 2.0 created this file. For more info see http://www.lyx.org/
\lyxformat 413
\begin_document
\begin_header
\textclass article
\use_default_options true
\maintain_unincluded_children false
\language english
\language_package default
\inputencoding auto
\fontencoding global
\font_roman default
\font_sans default
\font_typewriter default
\font_default_family default
\use_non_tex_fonts false
\font_sc false
\font_osf false
\font_sf_scale 100
\font_tt_scale 100
\graphics default
\default_output_format default
\output_sync 0
\bibtex_command default
\index_command default
\paperfontsize default
\spacing single
\use_hyperref false
\papersize default
\use_geometry false
\use_amsmath 1
\use_esint 1
\use_mhchem 1
\use_mathdots 1
\cite_engine basic
\use_bibtopic false
\use_indices false
\paperorientation portrait
\suppress_date false
\use_refstyle 1
\index Index
\shortcut idx
\color #008000
\end_index
\secnumdepth 3
\tocdepth 3
\paragraph_separation indent
\paragraph_indentation default
\quotes_language english
\papercolumns 1
\papersides 1
\paperpagestyle default
\tracking_changes false
\output_changes false
\html_math_output 0
\html_css_as_file 0
\html_be_strict false
\end_header
\begin_body
\begin_layout Title
Pontarius XMPP 0.1 Manual (Third Draft)
\end_layout
\begin_layout Author
The Pontarius Project
\end_layout
\begin_layout Date
The 6th of July, 2011
\end_layout
\begin_layout Standard
\begin_inset CommandInset toc
LatexCommand tableofcontents
\end_inset
\end_layout
\begin_layout Section
Introduction
\end_layout
\begin_layout Standard
Pontarius XMPP aims to be a convenient-to-use, powerful, correct, secure,
and extendable XMPP client library for Haskell.
It is written by Jon Kristensen and Mahdi Abdinejadi.
Being licensed under the GNU Lesser General Public License, Pontarius XMPP
is free and open source software.
\end_layout
\begin_layout Section
Features and Implementation Specifics
\end_layout
\begin_layout Standard
Pontarius XMPP 0.1 implements the client capabilities of the XMPP Core specificat
ion (RFC 6120)
\begin_inset Foot
status open
\begin_layout Plain Layout
http://tools.ietf.org/html/rfc6120
\end_layout
\end_inset
.
Below are the specifics of our implementation.
\end_layout
\begin_layout Itemize
The client is always the initiating entity
\end_layout
\begin_layout Itemize
A client-of-server connection is always exactly one TCP connection
\end_layout
\begin_layout Itemize
TLS is supported for client-to-server confidentiality
\end_layout
\begin_layout Itemize
Only the SCRAM authentication method is supported
\end_layout
\begin_layout Itemize
...
\end_layout
\begin_layout Standard
Later versions will add supports for different XMPP extensions, such as
RFC 6121 (XMPP IM), XEP-0004: Data Forms, and XEP-0077: In-Band Registration.
\begin_inset Foot
status open
\begin_layout Plain Layout
XMPP RFCs can be found at http://xmpp.org/xmpp-protocols/rfcs/, and the so-called
XEPs at http://xmpp.org/xmpp-protocols/xmpp-extensions/.
\end_layout
\end_inset
\end_layout
\begin_layout Section
Usage
\end_layout
\begin_layout Standard
Working with Pontarius XMPP is mostly done asynchronously; Pontarius XMPP
``owns'' the XMPP thread, and calls different StateT s m a callback functions
in the client.
StateT is a monad transformer which allows the functions to be stateful
(being able to access and modify the arbitrary client-defined state of
type s) and to be executed on top of a MonadIO m monad (typically IO).
\end_layout
\begin_layout Subsection
Creating the session
\end_layout
\begin_layout Standard
Setting up an XMPP session is done through the (blocking) session function:
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
session :: (MonadIO m, ClientState s m) => s ->
\end_layout
\begin_layout Plain Layout
[ClientHandler s m] -> (StateT s m ()) -> m ()
\end_layout
\end_inset
\end_layout
\begin_layout Standard
The first parameter (of type s) is an arbitrary state that is defined by
the client.
This is the initial state, and it will be passed to the stateful client
callbacks.
It will typically be modified by the client.
\end_layout
\begin_layout Standard
The second parameter is the list of client handlers to deal with XMPP callbacks.
The reason why we have a list is because we want to provide a ``layered''
system of XMPP event handlers.
For example, XMPP client developers may want to have a dedicated handler
to manage messages, implement a spam protection system, and so on.
Messages are piped through these handlers one by one, and any handler may
block the message from being sent to the next handler(s) above in the stack.
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
data MonadIO m => ClientHandler s m = ClientHandler {
\end_layout
\begin_layout Plain Layout
messageReceived :: Maybe (Message ->
\end_layout
\begin_layout Plain Layout
StateT s m Bool), presenceReceived :: Maybe
\end_layout
\begin_layout Plain Layout
(Presence -> StateT s m Bool), iqReceived ::
\end_layout
\begin_layout Plain Layout
Maybe (IQ -> StateT s m Bool),
\end_layout
\begin_layout Plain Layout
sessionTerminated :: Maybe (TerminationReason ->
\end_layout
\begin_layout Plain Layout
StateT s m ()) }
\end_layout
\end_inset
\end_layout
\begin_layout Standard
ClientHandler is a record which specifies four callback functions.
The first three deals with the three XMPP stanzas, and are called once
an XMPP stanza is received.
These functions take the stanza in question, and are stateful with the
current client state.
The boolean value returned signals whether or not the message should be
blocked to clients further down the stack.
For example, a XEP-0030: Service Discovery handler may choose to hide disco#inf
o requests handlers above it in the stack.
The last function is the callback that is used when the XMPP session is
terminated.
All callbacks are optional.
\end_layout
\begin_layout Standard
The third argument to session is a callback function that will be called
when the session has been initialized.
\end_layout
\begin_layout Standard
Any function with access to the Session object can operate with the XMPP
session, such as connecting the XMPP client or sending stanzas.
More on this below.
\end_layout
\begin_layout Subsection
Connecting the client
\end_layout
\begin_layout Standard
Different clients connect to XMPP in different ways.
Some secure the stream with TLS, and some authenticate with the server.
Pontarius XMPP provides a flexible function to help out with this in a
convenient way:
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
connect :: MonadIO m => Session s m -> HostName ->
\end_layout
\begin_layout Plain Layout
PortNumber -> Maybe (Certificate, (Certificate ->
\end_layout
\begin_layout Plain Layout
Bool)) -> Maybe (UserName, Password, Maybe
\end_layout
\begin_layout Plain Layout
Resource) -> (ConnectResult -> StateT s m ()) ->
\end_layout
\begin_layout Plain Layout
StateT s m ()
\end_layout
\end_inset
\end_layout
\begin_layout Standard
This function simply takes the host name and port number to connect to,
an optional tuple of the certificate to use and a function evaluating certifica
tes for TLS (if Nothing is provided, the connection will not be TLS secured),
and another optional tuple with user name, password, and an optional resource
for authentication (analogously, providing Nothing here causes Pontarius
XMPP not to authenticate).
The final paramter is a callback function providing the result of the connect
action.
\end_layout
\begin_layout Standard
For more fine-grained control of the connection, use the openStream, secureWithT
LS, and authenticate functions.
\end_layout
\begin_layout Subsection
Managing XMPP addresses
\end_layout
\begin_layout Standard
There are four functions dealing with XMPP addresses (or JIDs, as they are
also called):
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
fromString :: String -> Maybe Address
\end_layout
\begin_layout Plain Layout
fromStrings :: Maybe String -> String ->
\end_layout
\begin_layout Plain Layout
Maybe String -> Maybe Address
\end_layout
\begin_layout Plain Layout
isBare :: Address -> Bool
\end_layout
\begin_layout Plain Layout
isFull :: Address -> Bool
\end_layout
\end_inset
\end_layout
\begin_layout Standard
These functions should be pretty self-explainatory to those who know the
XMPP: Core standard.
The fromString functions takes one to three strings and tries to construct
an XMPP address.
isBare and isFull checks whether or not the bare is full (has a resource
value).
\end_layout
\begin_layout Subsection
Sending stanzas
\end_layout
\begin_layout Standard
Sending messages is done using this function:
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
sendMessage :: MonadIO m => Session s m -> Message ->
\end_layout
\begin_layout Plain Layout
Maybe (Message -> StateT s m Bool) ->
\end_layout
\begin_layout Plain Layout
Maybe (Timeout, StateT s m ()) ->
\end_layout
\begin_layout Plain Layout
Maybe (StreamError -> StateT s m ()) ->
\end_layout
\begin_layout Plain Layout
StateT s m ()
\end_layout
\end_inset
\end_layout
\begin_layout Standard
Like in section 3.2, the first parameter is the session object.
The second is the message (check the Message record type in the API).
The third parameter is an optional callback function to be executed if
a reply to the message is received.
The fourth parameter contains a Timeout (Integer) value, and a callback
that Pontarius XMPP will call when a reply has not been received in the
window of the timeout.
The last parameter is an optional callback that is called if a stream error
occurs.
\end_layout
\begin_layout Standard
Presence and IQ stanzas are sent in a very similar way.
\end_layout
\begin_layout Standard
Stanza IDs will be set for you if you leave them out.
If, however, you want to know what ID you send, you can acquire a stanza
ID by calling the getID function:
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
getID :: MonadIO m => Session s m -> StateT s m String
\end_layout
\end_inset
\end_layout
\begin_layout Subsection
Concurrent usage
\end_layout
\begin_layout Standard
Sometimes clients will want to perform XMPP actions from more than one thread,
or in other words, they want to perform actions from code that is not a
Pontarius XMPP callback.
For these use cases, use injectAction:
\end_layout
\begin_layout Standard
\begin_inset listings
inline false
status open
\begin_layout Plain Layout
injectAction :: MonadIO m => Session s m ->
\end_layout
\begin_layout Plain Layout
Maybe (StateT s m Bool) -> StateT s m () ->
\end_layout
\begin_layout Plain Layout
StateT s m ()
\end_layout
\end_inset
\end_layout
\begin_layout Standard
The second parameter is an optional predicate callback to be executed right
before the third parameter callback is called.
If it is provided and evaluates to False, then the action will not be called.
Otherwise, the action will be called.
\end_layout
\begin_layout Subsection
Example echo server
\end_layout
\begin_layout Standard
We provide an example to further illustrate the Pontarius XMPP API and to
make it easier for developers to get started with the library.
The program illustrates how to connect, authenticate, set a presence, and
echo all messages received.
It only uses one client handler.
The contents of this example may be used freely, as if it is in the public
domain.
You find it in the Examples directory of the Pontarius XMPP source code.
\end_layout
\end_body
\end_document

192
Documentation/Software Design Description for Pontarius XMPP 1.0.lyx
Unescape View File

@ -0,0 +1,192 @@ @@ -0,0 +1,192 @@
#LyX 2.0 created this file. For more info see http://www.lyx.org/
\lyxformat 413
\begin_document
\begin_header
\textclass article
\use_default_options true
\maintain_unincluded_children false
\language english
\language_package default
\inputencoding auto
\fontencoding global
\font_roman default
\font_sans default
\font_typewriter default
\font_default_family default
\use_non_tex_fonts false
\font_sc false
\font_osf false
\font_sf_scale 100
\font_tt_scale 100
\graphics default
\default_output_format default
\output_sync 0
\bibtex_command default
\index_command default
\paperfontsize default
\use_hyperref false
\papersize default
\use_geometry false
\use_amsmath 1
\use_esint 1
\use_mhchem 1
\use_mathdots 1
\cite_engine basic
\use_bibtopic false
\use_indices false
\paperorientation portrait
\suppress_date false
\use_refstyle 1
\index Index
\shortcut idx
\color #008000
\end_index
\secnumdepth 3
\tocdepth 3
\paragraph_separation indent
\paragraph_indentation default
\quotes_language english
\papercolumns 1
\papersides 1
\paperpagestyle default
\tracking_changes false
\output_changes false
\html_math_output 0
\html_css_as_file 0
\html_be_strict false
\end_header
\begin_body
\begin_layout Title
Software Design Description for Pontarius XMPP 1.0 (First Draft)
\end_layout
\begin_layout Author
The Pontarius Project
\end_layout
\begin_layout Date
15th of June, 2011
\end_layout
\begin_layout Standard
\begin_inset CommandInset toc
LatexCommand tableofcontents
\end_inset
\end_layout
\begin_layout Section
Introduction
\end_layout
\begin_layout Standard
Purpose
\end_layout
\begin_layout Standard
Scope
\end_layout
\begin_layout Standard
Definitions and acronyms
\end_layout
\begin_layout Section
References
\end_layout
\begin_layout Section
Decomposition description
\end_layout
\begin_layout Subsection
Module decomposition
\end_layout
\begin_layout Subsection
Concurrent process decomposition
\end_layout
\begin_layout Subsection
Data decomposition
\end_layout
\begin_layout Section
Dependency description
\end_layout
\begin_layout Subsection
Intermodule dependencies
\end_layout
\begin_layout Subsection
Interprocess dependencies
\end_layout
\begin_layout Subsection
Data dependencies
\end_layout
\begin_layout Section
Interface description
\end_layout
\begin_layout Subsection
Module interface
\end_layout
\begin_layout Subsubsection
Module 1 description
\end_layout
\begin_layout Subsubsection
Module 2 description
\end_layout
\begin_layout Subsection
Process interface
\end_layout
\begin_layout Subsubsection
Process 1 description
\end_layout
\begin_layout Subsubsection
Process 2 description
\end_layout
\begin_layout Section
Detailed design
\end_layout
\begin_layout Subsection
Module detailed design
\end_layout
\begin_layout Subsubsection
Module 1 detail
\end_layout
\begin_layout Subsubsection
Module 2 detail
\end_layout
\begin_layout Subsection
Data detailed design
\end_layout
\begin_layout Subsubsection
Module 1 detail
\end_layout
\begin_layout Subsubsection
Module 2 detail
\end_layout
\end_body
\end_document

324
Documentation/Software Quality Assurance Plan for Pontarius XMPP 1.0.lyx
Unescape View File

@ -0,0 +1,324 @@ @@ -0,0 +1,324 @@
#LyX 2.0 created this file. For more info see http://www.lyx.org/
\lyxformat 413
\begin_document
\begin_header
\textclass article
\use_default_options true
\maintain_unincluded_children false
\language english
\language_package default
\inputencoding auto
\fontencoding global
\font_roman default
\font_sans default
\font_typewriter default
\font_default_family default
\use_non_tex_fonts false
\font_sc false
\font_osf false
\font_sf_scale 100
\font_tt_scale 100
\graphics default
\default_output_format default
\output_sync 0
\bibtex_command default
\index_command default
\paperfontsize default
\use_hyperref false
\papersize default
\use_geometry false
\use_amsmath 1
\use_esint 1
\use_mhchem 1
\use_mathdots 1
\cite_engine basic
\use_bibtopic false
\use_indices false
\paperorientation portrait
\suppress_date false
\use_refstyle 1
\index Index
\shortcut idx
\color #008000
\end_index
\secnumdepth 3
\tocdepth 3
\paragraph_separation indent
\paragraph_indentation default
\quotes_language english
\papercolumns 1
\papersides 1
\paperpagestyle default
\tracking_changes false
\output_changes false
\html_math_output 0
\html_css_as_file 0
\html_be_strict false
\end_header
\begin_body
\begin_layout Title
Software Quality Assurance Plan for Pontarius XMPP 1.0
\end_layout
\begin_layout Author
Jon Kristensen
\end_layout
\begin_layout Date
6th of June, 2011
\end_layout
\begin_layout Standard
\begin_inset CommandInset toc
LatexCommand tableofcontents
\end_inset
\end_layout
\begin_layout Section
Purpose
\end_layout
\begin_layout Standard
The purpose of writing this SQAP is not only to increase the quality of
Pontarius XMPP, but also to evaluate the use of the IEEE Standard for Software
Quality Assurance Plans (IEEE Std 730-1998) standard as well as meeting
the goals of a university course in IT quality management.
For information on the intended use of the software, please consult the
Pontarius XMPP 1.0 Software Requirement Specification.
The applicable portions of the software's life cycle from its first beta
until its disposal phase.
\end_layout
\begin_layout Section
Reference documents
\end_layout
\begin_layout Enumerate
IEEE Standard for Software Quality Assurance Plans (IEEE Std 730-1998)
\end_layout
\begin_layout Enumerate
Pontarius XMPP 1.0 Software Requirement Specification
\end_layout
\begin_layout Section
Legal notice
\end_layout
\begin_layout Standard
Pontarius XMPP is a free and open source software project.
The
\begin_inset Quotes eld
\end_inset
Pontarius project
\begin_inset Quotes erd
\end_inset
is not a legal entity, but is like a synonym for Jon Kristensen.
Jon Kristensen does DOES NOT TAKE ANY RESPONSIBILITY OR OFFER ANY GUARANTEES
in regards to the software, its quality or this document.
Furthermore, the software is provided
\begin_inset Quotes eld
\end_inset
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE
\begin_inset Quotes erd
\end_inset
.
Consult the GNU General Public License for more information.
This aspect particularly influences the next section of this document.
\end_layout
\begin_layout Section
Management
\end_layout
\begin_layout Standard
The
\begin_inset Quotes eld
\end_inset
organization
\begin_inset Quotes erd
\end_inset
behind the software is the project founder, project leader, and copyright
holder Jon Kristensen, which acts in a
\begin_inset Quotes eld
\end_inset
benevolent dictator
\begin_inset Quotes erd
\end_inset
position for the free and open source project.
The Pontarius project hopes that Pontarius XMPP will grow to become the
de-facto XMPP library for Haskell, and that we will get voluntary feedback
from multiple testers from different communities, such as the Haskell and
XMPP communities, as well as the free and open source software community
as a whole.
We will do what we can to organize and act on that feedback; however, the
only person that has currently even
\emph on
planned
\emph default
to perform software quality assurance activities is Jon Kristensen.
\end_layout
\begin_layout Standard
[Lifecycle of software, Sequence of tasks (with emphasis on activities),
relationships between tasks and major checkpoints]
\end_layout
\begin_layout Standard
(Testing API, extending Pontarius XMPP with a set of RFCs and/or XEPs, unit
testing, performance testing, stress testing, code (un)coverage...)
\end_layout
\begin_layout Section
Documentation
\end_layout
\begin_layout Subsection
Purpose
\end_layout
\begin_layout Subsection
Minimum documentation requirements
\end_layout
\begin_layout Subsubsection
Software Requirements Specification
\end_layout
\begin_layout Subsubsection
Software Design Description
\end_layout
\begin_layout Subsubsection
Software Verification and Validation Plan
\end_layout
\begin_layout Subsubsection
User Documentation
\end_layout
\begin_layout Subsubsection
Software Configuration Management Plan
\end_layout
\begin_layout Section
Standards, practices, conventions, and metrics
\end_layout
\begin_layout Subsection
Purpose
\end_layout
\begin_layout Subsection
Content
\end_layout
\begin_layout Section
Reviews and audits
\end_layout
\begin_layout Subsection
Purpose
\end_layout
\begin_layout Subsection
Minimum requirements
\end_layout
\begin_layout Subsection
Software Requirements Review
\end_layout
\begin_layout Subsection
Preliminary Design Review
\end_layout
\begin_layout Subsection
Critical Design Review
\end_layout
\begin_layout Subsection
Software Verification and Validation Plan Review
\end_layout
\begin_layout Subsubsection
Functional audit
\end_layout
\begin_layout Subsubsection
Physical audit
\end_layout
\begin_layout Subsubsection
In-process audits
\end_layout
\begin_layout Subsubsection
Manegerial reviews
\end_layout
\begin_layout Subsubsection
Software Configuration Management Plan Review
\end_layout
\begin_layout Subsubsection
Post-mortem review
\end_layout
\begin_layout Subsubsection
User Documentation Review
\end_layout
\begin_layout Subsection
Test
\end_layout
\begin_layout Section
Problem reporting and corrective actions
\end_layout
\begin_layout Section
Tools, technologies, and methodologies
\end_layout
\begin_layout Section
Code control
\end_layout
\begin_layout Section
Media control
\end_layout
\begin_layout Section
Supplier control
\end_layout
\begin_layout Section
Records collection, maintainance, and retention
\end_layout
\begin_layout Section
Training
\end_layout
\begin_layout Section
Risk management
\end_layout
\end_body
\end_document

1459
Documentation/Software Requirements Specification for Pontarius XMPP.lyx
View File

File diff suppressed because it is too large Load Diff

147
Examples/EchoClient.hs
Unescape View File

@ -0,0 +1,147 @@ @@ -0,0 +1,147 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file (EchoClient.hs) illustrates how to connect, authenticate, set a
presence, and echo messages with Pontarius XMPP. The contents of this file may
be used freely, as if it is in the public domain.
In any state-aware function (function operating in the StateT monad) you can get
and set the current by writing
@CMS.get >>= \ state -> CMS.put $ state { stateTest = 10 } ...@
or, if you prefer the do-notation,
@do
state <- CMS.get
CMS.put $ state { stateTest = 10 }
...@
-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Examples.EchoClient () where
import Network.XMPP
import qualified Control.Monad as CM
import qualified Control.Monad.State as CMS
import qualified Control.Monad.IO.Class as CMIC
import qualified Data.Maybe as DM
-- Account and server details.
hostName = "jonkristensen.com"
userName = "pontarius"
serverIdentifier = "jonkristensen.com"
portNumber = 5222
resource = "echo-client"
password = ""
-- The client state, containing the required Pontarius XMPP Session object. It
-- also contains a dummy integer value to illustrate how client states are used.
data State = State { stateSession :: Maybe (Session State IO)
, stateTest :: Integer }
defaultState :: State
defaultState = State { stateSession = Nothing
, stateTest = 5 }
instance ClientState State IO where
putSession st se = st { stateSession = Just se }
-- This client defines one client handler, and only specifies the
-- messageReceived callback.
clientHandlers = [ClientHandler { messageReceived = Just messageReceived_
, presenceReceived = Nothing
, iqReceived = Nothing
, sessionTerminated = Nothing }]
-- The main function sets up the Pontarius XMPP session with the default client
-- state and client handler defined above, as well as specifying that the
-- sessionCreated function should be called when the session has been created.
main :: IO ()
main = do
session
defaultState
clientHandlers
sessionCreated
-- The session has been created. Let's try to open the XMPP stream!
sessionCreated :: CMS.StateT State IO ()
sessionCreated = do
state <- CMS.get
connect (DM.fromJust $ stateSession state) hostName portNumber
(Just ("", \ x -> True)) (Just (userName, password, Just resource))
connectCallback
id <- getID (DM.fromJust $ stateSession state)
CMIC.liftIO $ putStrLn $ "Unique ID acquired: " ++ id
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ())
return ()
-- We have tried to connected, TLS secured and authenticated!
connectCallback :: ConnectResult -> CMS.StateT State IO ()
connectCallback r = do
state <- CMS.get
case r of
ConnectSuccess _ _ _ -> do
sendPresence (DM.fromJust $ stateSession state)
Presence { presenceID = Nothing
, presenceFrom = Nothing
, presenceTo = Nothing
, presenceXMLLang = Nothing
, presenceType = Available
, presencePayload = [] }
Nothing Nothing Nothing
_ -> do
CMIC.liftIO $ putStrLn "Could not connect."
return ()
-- A message (stanza) has been received. Let's echo it!
messageReceived_ :: Message -> CMS.StateT State IO Bool
messageReceived_ m = do
state <- CMS.get
CMIC.liftIO $ putStrLn $
"Received a message; echoing it! By the way: Internal state is " ++
(show $ stateTest state) ++ "."
sendMessage (DM.fromJust $ stateSession state)
Message { messageID = messageID m
, messageFrom = Nothing
, messageTo = messageFrom m
, messageXMLLang = Nothing
, messageType = messageType m
, messagePayload = messagePayload m }
Nothing (Just (0, (do CMIC.liftIO $ putStrLn "Timeout!"; return ()))) Nothing
return True

4
LICENSE
Unescape View File

@ -0,0 +1,4 @@ @@ -0,0 +1,4 @@
Copyright © 2010-2011, Jon Kristensen.
Pontarius XMPP is licensed under GNU Lesser General Public License, version 3.
See COPYING and COPYING.LESSER for more information.

106
Network/XMPP.hs
Unescape View File

@ -0,0 +1,106 @@ @@ -0,0 +1,106 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Module: $Header$
-- Description: A minimalistic and easy-to-use XMPP library
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
-- Pontarius XMPP aims to be a secure, concurrent/event-based and easy-to-use
-- XMPP library for Haskell. It is being actively developed.
--
-- Note that we are not recommending anyone to use Pontarius XMPP at this time
-- as it's still in an experimental stage and will have its API and data types
-- modified frequently. See the project's web site at
-- <http://www.pontarius.org/> for more information.
--
-- This module will be documented soon.
module Network.XMPP ( -- Network.XMPP.JID
Address (..)
, Localpart
, Serverpart
, Resourcepart
, isFull
, isBare
, fromString
, fromStrings
-- Network.XMPP.SASL
, replyToChallenge1
-- Network.XMPP.Session
, Certificate
, ClientHandler (..)
, ClientState (..)
, ConnectResult (..)
, HostName
, Password
, PortNumber
, Resource
, Session
, TerminationReason
, UserName
, sendIQ
, sendPresence
, sendMessage
, connect
, openStream
, secureWithTLS
, authenticate
, session
, OpenStreamResult (..)
, SecureWithTLSResult (..)
, AuthenticateResult (..)
-- Network.XMPP.Stanza
, StanzaID (SID)
, From
, To
, XMLLang
, MessageType (..)
, Message (..)
, PresenceType (..)
, Presence (..)
, IQ (..)
, iqPayloadNamespace
, iqPayload
, injectAction
-- Network.XMPP.Utilities
, elementToString
, elementsToString
, getID ) where
import Network.XMPP.Address
import Network.XMPP.SASL
import Network.XMPP.Session
import Network.XMPP.Stanza
import Network.XMPP.Utilities
import Network.XMPP.Types
import Network.XMPP.TLS
import Network.XMPP.Stream

216
Network/XMPP/Address.hs
Unescape View File

@ -0,0 +1,216 @@ @@ -0,0 +1,216 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- TODO: Move away from stringprep for all three profiles.
-- TODO: When no longer using stringprep, do appropriate testing. (Including
-- testing addresses like a@b/c@d/e, a/b@c, a@/b, a/@b...)
-- TODO: Unicode 3.2 should be used.
-- |
-- Module: $Header$
-- Description: Data type and utility functions for XMPP addresses (JIDs)
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
--
-- This module deals with XMPP addresses (also known as JIDs and JabberIDs). For
-- more information on XMPP addresses, see RFC 6122: XMPP: Address Format.
--
-- Provided hostnames may contain international characters; Pontarius XMPP will
-- try to convert such hostnames to internationalized hostnames.
module Network.XMPP.Address (fromString, fromStrings, isBare, isFull) where
import Network.XMPP.Types
import Data.Maybe (fromJust, isJust)
import Text.Parsec ((<|>), anyToken, char, eof, many, noneOf, parse)
import Text.Parsec.ByteString (GenParser)
import Text.StringPrep (StringPrepProfile (..), a1, b1, b2, c11, c12, c21, c22,
c3, c4, c5, c6, c7, c8, c9, runStringPrep)
import Text.NamePrep (namePrepProfile)
import Data.Text.IDNA2008 (toASCII)
import Network.URI (isIPv4address, isIPv6address)
import qualified Data.ByteString.Char8 as DBC (pack)
import qualified Data.Text as DT (pack, unpack)
-- |
-- Converts a string to an XMPP address.
fromString :: String -> Maybe Address
fromString s = fromStrings localpart serverpart resourcepart
where
Right (localpart, serverpart, resourcepart) =
parse addressParts "" (DBC.pack s)
-- |
-- Converts localpart, serverpart, and resourcepart strings to an XMPP address.
-- Runs the appropriate stringprep profiles and validates the parts.
fromStrings :: Maybe String -> String -> Maybe String -> Maybe Address
fromStrings l s r
| serverpart == Nothing = Nothing
| otherwise = if validateNonServerpart localpart &&
isJust serverpart' &&
validateNonServerpart resourcepart
then Just (Address localpart (fromJust serverpart') resourcepart)
else Nothing
where
-- Applies the nodeprep profile on the localpart string, if any.
localpart :: Maybe String
localpart = case l of
Just l' -> case runStringPrep nodeprepProfile (DT.pack l') of
Just l'' -> Just $ DT.unpack l''
Nothing -> Nothing
Nothing -> Nothing
-- Applies the nameprep profile on the serverpart string.
-- TODO: Allow unassigned?
serverpart :: Maybe String
serverpart = case runStringPrep (namePrepProfile False) (DT.pack s) of
Just s' -> Just $ DT.unpack s'
Nothing -> Nothing
-- Applies the resourceprep profile on the resourcepart string, if any.
resourcepart :: Maybe String
resourcepart = case r of
Just r' -> case runStringPrep resourceprepProfile (DT.pack r') of
Just r'' -> Just $ DT.unpack r''
Nothing -> Nothing
Nothing -> Nothing
-- Returns the serverpart if it was a valid IP or if the toASCII
-- function was successful, or Nothing otherwise.
serverpart' :: Maybe String
serverpart' | isIPv4address s || isIPv6address s = Just s
| otherwise = toASCII s
-- Validates that non-serverpart strings have an appropriate length.
validateNonServerpart :: Maybe String -> Bool
validateNonServerpart Nothing = True
validateNonServerpart (Just l) = validPartLength l
where
validPartLength :: String -> Bool
validPartLength p = length p > 0 && length p < 1024
-- | Returns True if the address is `bare', and False otherwise.
isBare :: Address -> Bool
isBare j | resourcepart j == Nothing = True
| otherwise = False
-- | Returns True if the address is `full', and False otherwise.
isFull :: Address -> Bool
isFull jid = not $ isBare jid
-- Parses an address string and returns its three parts. It performs no
-- validation or transformations. We are using Parsec to parse the address.
-- There is no input for which 'addressParts' fails.
addressParts :: GenParser Char st (Maybe String, String, Maybe String)
addressParts = do
-- Read until we reach an '@', a '/', or EOF.
a <- many $ noneOf ['@', '/']
-- Case 1: We found an '@', and thus the localpart. At least the serverpart
-- is remaining. Read the '@' and until a '/' or EOF.
do
char '@'
b <- many $ noneOf ['/']
-- Case 1A: We found a '/' and thus have all the address parts. Read the
-- '/' and until EOF.
do
char '/' -- Resourcepart remaining
c <- many $ anyToken -- Parse resourcepart
eof
return (Just a, b, Just c)
-- Case 1B: We have reached EOF; the address is in the form
-- localpart@serverpart.
<|> do
eof
return (Just a, b, Nothing)
-- Case 2: We found a '/'; the address is in the form
-- serverpart/resourcepart.
<|> do
char '/'
b <- many $ anyToken
eof
return (Nothing, a, Just b)
-- Case 3: We have reached EOF; we have an address consisting of only a
-- serverpart.
<|> do
eof
return (Nothing, a, Nothing)
nodeprepProfile :: StringPrepProfile
nodeprepProfile = Profile { maps = [b1, b2]
, shouldNormalize = True
, prohibited = [a1] ++ [c11, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
, shouldCheckBidi = True }
-- These needs to be checked for after normalization. We could also look up the
-- Unicode mappings and include a list of characters in the prohibited field
-- above. Let's defer that until we know that we are going to use stringprep.
nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F', '\x3A',
'\x3C', '\x3E', '\x40']
resourceprepProfile :: StringPrepProfile
resourceprepProfile = Profile { maps = [b1]
, shouldNormalize = True
, prohibited = [a1] ++ [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
, shouldCheckBidi = True }

215
Network/XMPP/SASL.hs
Unescape View File

@ -0,0 +1,215 @@ @@ -0,0 +1,215 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- TODO: Make it possible to include host.
-- TODO: Host is assumed to be ISO 8859-1; make list of assumptions.
-- TODO: Can it contain newline characters?
module Network.XMPP.SASL (replyToChallenge1) where
import Data.ByteString.Internal (c2w)
import Data.Char (isLatin1)
import Data.Digest.Pure.MD5
import qualified Data.Binary as DBi (Binary, encode)
import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack,
fromChunks, toChunks, null)
import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack)
import qualified Data.List as DL
data Challenge1Error = C1MultipleCriticalAttributes |
C1NotAllParametersPresent |
C1SomeParamtersPresentMoreThanOnce |
C1WrongRealm |
C1UnsupportedAlgorithm |
C1UnsupportedCharset |
C1UnsupportedQOP
deriving Show
-- Will produce a list of key-value pairs given a string in the format of
-- realm="somerealm",nonce="OA6MG9tEQGm2hh",qop="auth",charset=utf-8...
stringToList :: String -> [(String, String)]
stringToList "" = []
stringToList s' = let (next, rest) = break' s' ','
in break' next '=' : stringToList rest
where
-- Like break, but will remove the first char of the continuation, if
-- present.
break' :: String -> Char -> (String, String)
break' s' c = let (first, second) = break ((==) c) s'
in (first, removeCharIfPresent second c)
-- Removes the first character, if present; "=hello" with '=' becomes
-- "hello".
removeCharIfPresent :: String -> Char -> String
removeCharIfPresent [] _ = []
removeCharIfPresent (c:t) c' | c == c' = t
removeCharIfPresent s' c = s'
-- Counts the number of directives in the pair list.
countDirectives :: String -> [(String, String)] -> Int
countDirectives v l = DL.length $ filter (isEntry v) l
where
isEntry :: String -> (String, String) -> Bool
isEntry name (name', _) | name == name' = True
| otherwise = False
-- Returns the given directive in the list of pairs, or Nothing.
lookupDirective :: String -> [(String, String)] -> Maybe String
lookupDirective d [] = Nothing
lookupDirective d ((d', v):t) | d == d' = Just v
| otherwise = lookupDirective d t
-- Returns the given directive in the list of pairs, or the default value
-- otherwise.
lookupDirectiveWithDefault :: String -> [(String, String)] -> String -> String
lookupDirectiveWithDefault di l de
| lookup == Nothing = de
| otherwise = let Just r = lookup in r
where
lookup = lookupDirective di l
-- Takes a challenge string (which is not Base64-encoded), the host name of the
-- Jabber server, the Jabber user name (JID), the password and a random and
-- unique "cnonce" value and generates either an error or a response to that
-- challenge.
-- We have broken replyToChallenge1 for non-TLS authentication. In order to
-- change it back, just uncomment the lines relevant to the realm and match it
-- in the C1NotAllParametersSet case.
replyToChallenge1 :: String -> String -> String -> String -> String ->
Either String Challenge1Error
replyToChallenge1 s h u p c =
-- Remove all new line characters.
let list = stringToList $ filter (/= '\n') s
in -- Count that there are no more than one nonce or algorithm directives.
case countDirectives "nonce" list <= 1 &&
countDirectives "algorithm" list <= 1 of
True ->
let -- realm = lookupDirective "realm" list
nonce = lookupDirective "nonce" list
qop = lookupDirectiveWithDefault "qop" list "auth"
charset = lookupDirectiveWithDefault "charset" list "utf-8"
algorithm = lookupDirective "algorithm" list
-- Verify that all necessary directives has been set.
in case (nonce, qop, charset, algorithm) of
(Just nonce', qop', charset', Just algorithm') ->
-- Strip quotations of the directives that need it.
let -- realm'' = stripQuotations realm'
nonce'' = stripQuotations nonce'
qop'' = stripQuotations qop' -- It seems ejabberd gives us an errorous "auth" instead of auth
in
-- -- Verify that the realm is the same as the Jabber host.
-- case realm'' == h of
-- True ->
-- Verify that QOP is "auth", charset is "utf-8" and that
-- the algorithm is "md5-sess".
case qop'' == "auth" of
True ->
case charset' == "utf-8" of
True ->
case algorithm' == "md5-sess" of
True ->
-- All data is valid; generate the reply.
Left (reply nonce'' qop'')
-- Errors are caught and reported below.
False -> Right C1UnsupportedAlgorithm
False -> Right C1UnsupportedCharset
False -> Right C1UnsupportedQOP
-- False -> Right C1WrongRealm
_ -> Right C1NotAllParametersPresent
where
reply n q =
let -- We start with what's in RFC 2831 is referred to as "A1", a 16 octet
-- MD5 hash.
-- If the username or password values are in ISO-8859-1, we convert
-- them to ISO-8859-1 strings.
username = case all isLatin1 u of
True -> DBL.pack $ map c2w u
False -> DBLC.pack $ u
password = case all isLatin1 p of
True -> DBL.pack $ map c2w p
False -> DBLC.pack p
nc = "00000001"
digestUri = "xmpp/" ++ h
-- Build the "{ username-value, ":", realm-value, ":", passwd }"
-- bytestring, the rest of the bytestring and then join them.
a1a = DBi.encode $ md5 $ DBLC.append
(DBLC.append username (DBLC.pack (":" ++ h ++ ":")))
password
a1aDebug = "DBi.encode $ md5 $ " ++ (DBLC.unpack $ DBLC.append
(DBLC.append username (DBLC.pack (":" ++ h ++ ":")))
password)
a1b = DBLC.pack (":" ++ n ++ ":" ++ c)
a1 = DBLC.append a1a a1b
-- Generate the "A2" value.
a2 = DBLC.pack ("AUTHENTICATE:" ++ digestUri)
-- Produce the responseValue.
k = DBLC.pack (show $ md5 a1)
colon = DBLC.pack ":"
s0 = DBLC.pack (n ++ ":" ++ nc ++ ":" ++ c ++ ":" ++
q ++ ":")
s1 = DBLC.pack $ show $ md5 a2
s_ = DBLC.append s0 s1
-- append k:d and 16 octet hash it
kd = md5 (DBLC.append k (DBLC.append colon s_))
lol0 = DBLC.unpack s_
lol1 = show kd
response = show kd
in "username=\"" ++ u ++ "\",realm=\"" ++ h ++ "\",nonce=\"" ++ n ++
"\",cnonce=\"" ++ c ++ "\",nc=" ++ nc ++ ",digest-uri=\"" ++
digestUri ++ "\",qop=auth,response=" ++ response ++ ",charset=utf-8"
-- "\n\n" ++
-- "a1aDebug: " ++ a1aDebug ++ "\n" ++
-- "a1b: " ++ (DBLC.unpack a1b) ++ "\n" ++
-- "a1: " ++ (DBLC.unpack a1) ++ "\n" ++
-- "a2: " ++ (DBLC.unpack a2) ++ "\n" ++
-- "k: " ++ (DBLC.unpack k) ++ "\n" ++
-- "colon: " ++ (DBLC.unpack colon) ++ "\n" ++
-- "s0: " ++ (DBLC.unpack s0) ++ "\n" ++
-- "s1: " ++ (DBLC.unpack s1) ++ "\n" ++
-- "s_: " ++ (DBLC.unpack s_) ++ "\n"
-- Stripts the quotations around a string, if any; "\"hello\"" becomes "hello".
stripQuotations :: String -> String
stripQuotations "" = ""
stripQuotations s | (head s == '"') && (last s == '"') = tail $ init s
| otherwise = s

758
Network/XMPP/Session.hs
Unescape View File

@ -0,0 +1,758 @@ @@ -0,0 +1,758 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- TODO: Better functions and events for stanzas, IncomingIQ, OutgoingIQ, etc. (ClientSession, ClientStanza)
-- TODO: IO function to do everything related to the handle, instead of just connecting.
-- TODO: Enumerate in the same thread? Enumerate one element at the time, non-blocking?
-- I believe we need to use the MultiParamTypeClasses extension to be able to
-- work with arbitrary client states (solving the problem that the ClientState
-- type class is solving). However, I would be happy if someone proved me wrong.
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- Module: $Header$
-- Description: XMPP client session management module
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
--
-- This module provides the functions used by XMPP clients to manage their XMPP
-- sessions.
--
-- Working with Pontarius XMPP is mostly done asynchronously with callbacks;
-- Pontarius XMPP "owns" the XMPP thread and carries the client state with it. A
-- client consists of a list of client handlers to handle XMPP events. This is
-- all set up through a @Session@ object, which a client can create by calling
-- the (blocking) function @createSession@.
--
-- The Pontarius XMPP functions operate in an arbitrary MonadIO monad.
-- Typically, clients will use the IO monad.
--
-- For more information, see the Pontarius XMPP Manual.
module Network.XMPP.Session ( ClientHandler (..)
, ClientState (..)
, ConnectResult (..)
, Session
, TerminationReason
, OpenStreamResult (..)
, SecureWithTLSResult (..)
, AuthenticateResult (..)
, sendPresence
, sendIQ
, sendMessage
, connect
, openStream
, secureWithTLS
, authenticate
, session
, injectAction
, getID ) where
import Network.XMPP.Address
import Network.XMPP.SASL
import Network.XMPP.Stanza
import Network.XMPP.Stream
import Network.XMPP.TLS
import Network.XMPP.Types
import Network.XMPP.Utilities
import qualified Control.Exception as CE
import qualified Control.Exception.Base as CEB -- ?
import qualified Control.Monad.Error as CME
import qualified Control.Monad.State as CMS
import qualified Network as N
-------------
import Control.Concurrent.MVar
import Codec.Binary.UTF8.String
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.State hiding (State)
import Data.Enumerator (($$), Iteratee, continue, joinI,
run, run_, yield)
import Data.Enumerator.Binary (enumHandle, enumFile)
import Data.Maybe
import Data.String
import Data.XML.Types
import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)
import Network.TLS
import Network.TLS.Cipher
import System.IO (BufferMode, BufferMode(NoBuffering))
import Text.XML.Enumerator.Parse (parseBytes, decodeEntities)
import Text.XML.Enumerator.Document (fromEvents)
import qualified Codec.Binary.Base64.String as CBBS
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null)
import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack)
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import qualified Data.List as DL
import qualified Data.Text as DT
import qualified Data.Text.Lazy as DTL
-- =============================================================================
-- EXPORTED TYPES AND FUNCTIONS
-- =============================================================================
-- | The @Session@ object is used by clients when interacting with Pontarius
-- XMPP. It holds information needed by Pontarius XMPP; its content is not
-- accessible from the client.
data Session s m = Session { sessionChannel :: Chan (InternalEvent s m)
, sessionIDGenerator :: IDGenerator }
-- | A client typically needs one or more @ClientHandler@ objects to interact
-- with Pontarius XMPP. Each client handler may provide four callback
-- functions; the first three callbacks deals with received stanzas, and the
-- last one is used when the session is terminated.
--
-- These stanza functions takes the current client state and an object
-- containing the details of the stanza in question. The boolean returned
-- along with the possibly updated state signals whether or not the message
-- should be blocked to client handlerss further down the stack. For example,
-- an XEP-0030: Service Discovery handler may choose to hide disco\#info
-- requests to handlers above it in the stack.
--
-- The 'sessionTerminated' callback function takes a 'TerminationReason' value
-- along with the state and will be sent to all client handlers.
data MonadIO m => ClientHandler s m =
ClientHandler { messageReceived :: Maybe (Message -> StateT s m Bool)
, presenceReceived :: Maybe (Presence -> StateT s m Bool)
, iqReceived :: Maybe (IQ -> StateT s m Bool)
, sessionTerminated :: Maybe (TerminationReason ->
StateT s m ()) }
-- | @TerminationReason@ contains information on why the XMPP session was
-- terminated.
data TerminationReason = WhateverReason -- TODO
-- | Creates an XMPP session. Blocks the current thread. The first parameter,
-- @s@, is an arbitrary state that is defined by the client. This is the
-- initial state, and it will be passed to the client (handlers) as XMPP
-- events are emitted. The second parameter is the list of @ClientHandler@s;
-- this is a way to provide a "layered" system of XMPP event handlers. For
-- example, a client may have a dedicated handler to manage messages,
-- implement a spam protection system, etc. Messages are piped through these
-- handlers one by one, and any handler may block the message from being sent
-- to the next handler(s) above in the stack. The third argument is a callback
-- function that will be called when the session has been initialized, and
-- this function should be used by the client to store the Session object in
-- its state.
-- Creates the internal event channel, injects the Pontarius XMPP session object
-- into the ClientState object, runs the "session created" client callback (in
-- the new state context), and stores the updated client state in s''. Finally,
-- we launch the (main) state loop of Pontarius XMPP.
session :: (MonadIO m, ClientState s m) => s -> [ClientHandler s m] ->
(CMS.StateT s m ()) -> m ()
session s h c = do
threadID <- liftIO $ newEmptyMVar
chan <- liftIO $ newChan
idGenerator <- liftIO $ idGenerator "" -- TODO: Prefix
((), clientState) <- runStateT c (putSession s $ session_ chan idGenerator)
(result, _) <- runStateT (stateLoop chan)
(defaultState chan threadID h clientState idGenerator)
case result of
Just (CE.SomeException e) -> do
liftIO $ putStrLn "Got an exception!"
threadID' <- liftIO $ tryTakeMVar threadID
case threadID' of
Nothing -> do
liftIO $ putStrLn "No thread ID to kill"
Just t -> do
liftIO $ putStrLn "Killing thread"
liftIO $ killThread t
CE.throw e
Nothing ->
return ()
where
-- session :: Chan (InternalEvent m s) -> Session m s -- TODO
session_ c i = Session { sessionChannel = c, sessionIDGenerator = i }
defaultState :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) -> MVar ThreadId ->
[ClientHandler s m] -> s -> IDGenerator -> State s m
defaultState c t h s i = State { stateClientHandlers = h
, stateClientState = s
, stateChannel = c
, stateConnectionState = Disconnected
, stateStreamState = PreStream
, stateTLSState = NoTLS
, stateOpenStreamCallback = Nothing
, stateSecureWithTLSCallback = Nothing
, stateAuthenticateCallback = Nothing
, stateAuthenticationState = NoAuthentication
, stateResource = Nothing
, stateShouldExit = False
, stateThreadID = t
, statePresenceCallbacks = []
, stateMessageCallbacks = []
, stateIQCallbacks = []
, stateTimeoutStanzaIDs = []
, stateIDGenerator = i } -- TODO: Prefix
connect :: MonadIO m => Session s m -> HostName -> PortNumber ->
Maybe (Certificate, (Certificate -> Bool)) ->
Maybe (UserName, Password, Maybe Resource) ->
(ConnectResult -> StateT s m ()) -> StateT s m ()
connect s h p t a c = openStream s h p connect'
where
connect' r = case r of
OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support?
Just (certificate, certificateValidator) ->
secureWithTLS s certificate certificateValidator connect''
Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO
OpenStreamFailure -> c ConnectOpenStreamFailure
connect'' r = case r of
SecureWithTLSSuccess _ _ -> case a of
Just (userName, password, resource) ->
authenticate s userName password resource connect'''
Nothing -> connect''' (AuthenticateSuccess 1.0 "" "todo") -- TODO
SecureWithTLSFailure -> c ConnectSecureWithTLSFailure
connect''' r = case r of
AuthenticateSuccess streamProperties streamFeatures resource ->
c (ConnectSuccess streamProperties streamFeatures (Just resource))
AuthenticateFailure -> c ConnectAuthenticateFailure
openStream :: MonadIO m => Session s m -> HostName -> PortNumber ->
(OpenStreamResult -> StateT s m ()) -> StateT s m ()
openStream s h p c = CMS.get >>=
(\ state -> lift $ liftIO $ writeChan (sessionChannel s)
(IEC (CEOpenStream h p c)))
secureWithTLS :: MonadIO m => Session s m -> Certificate ->
(Certificate -> Bool) ->
(SecureWithTLSResult -> StateT s m ()) -> StateT s m ()
secureWithTLS s c a c_ = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel s)
(IEC (CESecureWithTLS c a c_)))
-- |
authenticate :: MonadIO m => Session s m -> UserName -> Password ->
Maybe Resource -> (AuthenticateResult -> StateT s m ()) ->
StateT s m ()
authenticate s u p r c = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel s)
(IEC (CEAuthenticate u p r c)))
sendMessage :: MonadIO m => Session s m -> Message -> Maybe (Message -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendMessage se m c t st = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel se)
(IEC (CEMessage m c t st)))
sendPresence :: MonadIO m => Session s m -> Presence -> Maybe (Presence -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendPresence se p c t st = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel se)
(IEC (CEPresence p c t st)))
sendIQ :: MonadIO m => Session s m -> IQ -> Maybe (IQ -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendIQ se i c t st = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel se)
(IEC (CEIQ i c t st)))
injectAction :: MonadIO m => Session s m -> Maybe (StateT s m Bool) -> StateT s m () -> StateT s m ()
injectAction s p a = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel s)
(IEC (CEAction p a)))
getID :: MonadIO m => Session s m -> StateT s m String
getID s = CMS.get >>= \ state -> lift $ liftIO $ nextID (sessionIDGenerator s) >>= \ id -> return id
-- xmppDisconnect :: MonadIO m => Session s m -> Maybe (s -> (Bool, s)) -> m ()
-- xmppDisconnect s c = xmppDisconnect s c
class ClientState s m where
putSession :: s -> Session s m -> s
-- =============================================================================
-- INTERNAL TYPES AND FUNCTIONS
-- =============================================================================
type OpenStreamCallback s m = Maybe (OpenStreamResult -> CMS.StateT s m ())
type SecureWithTLSCallback s m = Maybe (SecureWithTLSResult -> CMS.StateT s m ())
type AuthenticateCallback s m = Maybe (AuthenticateResult -> CMS.StateT s m ())
isConnected :: ConnectionState -> Bool
isConnected Disconnected = True
isConnected (Connected _ _) = True
data MonadIO m => State s m =
State { stateClientHandlers :: [ClientHandler s m]
, stateClientState :: s
, stateChannel :: Chan (InternalEvent s m)
, stateConnectionState :: ConnectionState -- s m
, stateTLSState :: TLSState
, stateStreamState :: StreamState
, stateOpenStreamCallback :: OpenStreamCallback s m
, stateSecureWithTLSCallback :: SecureWithTLSCallback s m
, stateAuthenticateCallback :: AuthenticateCallback s m
, stateAuthenticationState :: AuthenticationState
, stateResource :: Maybe Resource
, stateShouldExit :: Bool
, stateThreadID :: MVar ThreadId
, statePresenceCallbacks :: [(StanzaID, (Presence -> StateT s m Bool))]
, stateMessageCallbacks :: [(StanzaID, (Message -> StateT s m Bool))]
, stateIQCallbacks :: [(StanzaID, (IQ -> StateT s m Bool))]
, stateTimeoutStanzaIDs :: [StanzaID]
, stateIDGenerator :: IDGenerator
}
-- Repeatedly reads internal events from the channel and processes them. This is
-- the main loop of the XMPP session process.
-- The main loop of the XMPP library runs in the following monads:
--
-- m, m => MonadIO (from the client)
-- StateT
-- ErrorT
-- TODO: Will >> carry the updated state?
-- TODO: Should InternalState be in both places?
stateLoop :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) ->
StateT (State s m) m (Maybe CE.SomeException)
stateLoop c = do
event <- lift $ liftIO $ readChan c
lift $ liftIO $ putStrLn $ "Processing event " ++ (show event) ++ "."
result <- (processEvent event)
state <- get
case result of
Nothing -> do
case stateShouldExit state of
True ->
return $ Nothing
False ->
stateLoop c
Just e ->
return $ Just e
-- Process an InternalEvent and performs the necessary IO and updates the state
-- accordingly.
processEvent :: (MonadIO m, ClientState s m) => (InternalEvent s m) ->
(StateT (State s m) m) (Maybe CE.SomeException)
processEvent e = get >>= \ state ->
let handleOrTLSCtx = case stateTLSState state of
PostHandshake tlsCtx ->
Right tlsCtx
_ ->
let Connected _ handle = stateConnectionState state in Left handle
in case e of
-- ---------------------------------------------------------------------------
-- CLIENT EVENTS
-- ---------------------------------------------------------------------------
--
IEC (CEOpenStream hostName portNumber callback) -> do
CEB.assert (stateConnectionState state == Disconnected) (return ())
let portNumber' = fromIntegral portNumber
connectResult <- liftIO $ CE.try $ N.connectTo hostName
(N.PortNumber portNumber')
case connectResult of
Right handle -> do
put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle
, stateStreamState = PreStream
, stateOpenStreamCallback = Just callback }
lift $ liftIO $ hSetBuffering handle NoBuffering
lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ hostName ++
"' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.or" ++
"g/streams' version='1.0'>") (Left handle)
threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle)
lift $ liftIO $ putMVar (stateThreadID state) threadID
return Nothing
Left e -> do
let clientState = stateClientState state
((), clientState') <- lift $ runStateT (callback OpenStreamFailure) clientState
put $ state { stateShouldExit = True }
return $ Just e
IEC (CESecureWithTLS certificate verifyCertificate callback) -> do
-- CEB.assert (not $ isTLSSecured (stateStreamState state)) (return ())
let Connected _ handle = stateConnectionState state
lift $ liftIO $ send "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>" (Left handle)
put $ state { stateStreamState = PreStream
, stateSecureWithTLSCallback = Just callback }
return Nothing
-- TODO: Save callback in state.
IEC (CEAuthenticate userName password resource callback) -> do
-- CEB.assert (or [ stateConnectionState state == Connected
-- , stateConnectionState state == TLSSecured ]) (return ())
-- CEB.assert (stateHandle state /= Nothing) (return ())
put $ state { stateAuthenticationState = AuthenticatingPreChallenge1 userName password resource
, stateAuthenticateCallback = Just callback }
lift $ liftIO $ send "<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='DIGEST-MD5'/>" handleOrTLSCtx
return Nothing
IEE (EnumeratorXML (XEBeginStream stream)) -> do
put $ state { stateStreamState = PreFeatures (1.0) }
return Nothing
IEE (EnumeratorXML (XEFeatures features)) -> do
let PreFeatures streamProperties = stateStreamState state
case stateTLSState state of
NoTLS -> let callback = fromJust $ stateOpenStreamCallback state in do
((), clientState) <- lift $ runStateT (callback $ OpenStreamSuccess streamProperties "TODO") (stateClientState state)
put $ state { stateClientState = clientState
, stateStreamState = PostFeatures streamProperties "TODO" }
return Nothing
_ -> case stateAuthenticationState state of
AuthenticatedUnbound _ resource -> do -- TODO: resource
case resource of
Nothing -> do
lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"></bind></iq>") handleOrTLSCtx
return ()
_ -> do
lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"><resource>" ++ fromJust resource ++ "</resource></bind></iq>") handleOrTLSCtx
return ()
id <- liftIO $ nextID $ stateIDGenerator state
lift $ liftIO $ send ("<iq type=\"set\" id=\"" ++ id ++ "\"><session xmlns=\"urn:ietf:params:xml:ns:xmpp-session\"/>" ++ "</iq>") handleOrTLSCtx
-- TODO: Execute callback on iq result
let callback = fromJust $ stateAuthenticateCallback state in do -- TODO: streamProperties "TODO" after success
((), clientState) <- lift $ runStateT (callback $ AuthenticateSuccess streamProperties "TODO" "todo") (stateClientState state) -- get proper resource value when moving to iq result
put $ state { stateClientState = clientState
, stateStreamState = PostFeatures streamProperties "TODO" }
state' <- get
return Nothing
_ -> do
let callback = fromJust $ stateSecureWithTLSCallback state in do
((), clientState) <- lift $ runStateT (callback $ SecureWithTLSSuccess streamProperties "TODO") (stateClientState state)
put $ state { stateClientState = clientState
, stateStreamState = PostFeatures streamProperties "TODO" }
return Nothing
-- TODO: Can we assume that it's safe to start to enumerate on handle when it
-- might not have exited?
IEE (EnumeratorXML XEProceed) -> do
let Connected (ServerAddress hostName _) handle = stateConnectionState state
tlsCtx <- lift $ liftIO $ handshake' handle hostName
let tlsCtx_ = fromJust tlsCtx
put $ (defaultState (stateChannel state) (stateThreadID state) (stateClientHandlers state) (stateClientState state) (stateIDGenerator state)) { stateTLSState = PostHandshake tlsCtx_, stateConnectionState = (stateConnectionState state), stateSecureWithTLSCallback = (stateSecureWithTLSCallback state) }
threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Right tlsCtx_) -- double code
lift $ liftIO $ putStrLn "00000000000000000000000000000000"
lift $ liftIO $ swapMVar (stateThreadID state) threadID -- return value not used
lift $ liftIO $ putStrLn "00000000000000000000000000000000"
lift $ liftIO $ threadDelay 1000000
lift $ liftIO $ putStrLn "00000000000000000000000000000000"
lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++
hostName ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++
"streams' version='1.0'>") (Right tlsCtx_)
lift $ liftIO $ putStrLn "00000000000000000000000000000000"
return Nothing
IEE (EnumeratorXML (XEChallenge (Chal challenge))) -> do
let serverHost = "jonkristensen.com"
let challenge' = CBBS.decode challenge
case stateAuthenticationState state of
AuthenticatingPreChallenge1 userName password resource -> do
id <- liftIO $ nextID $ stateIDGenerator state
-- This is the first challenge - we need to calculate the reply
case replyToChallenge1 challenge' serverHost userName password id of
Left reply -> do
let reply' = (filter (/= '\n') (CBBS.encode reply))
lift $ liftIO $ send ("<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>" ++ reply' ++ "</response>") handleOrTLSCtx
put $ state { stateAuthenticationState = AuthenticatingPreChallenge2 userName password resource }
return ()
Right error -> do
state' <- get
lift $ liftIO $ putStrLn $ show error
return ()
AuthenticatingPreChallenge2 userName password resource -> do
-- This is not the first challenge; [...]
-- TODO: Can we assume "rspauth"?
lift $ liftIO $ send "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" handleOrTLSCtx
put $ state { stateAuthenticationState = AuthenticatingPreSuccess userName password resource }
return ()
return Nothing
-- We have received a SASL "success" message over a secured connection
-- TODO: Parse the success message?
-- TODO: <?xml version='1.0'?>?
IEE (EnumeratorXML (XESuccess (Succ _))) -> do
let serverHost = "jonkristensen.com"
let AuthenticatingPreSuccess userName _ resource = stateAuthenticationState state in do
lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ serverHost ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++ "streams' version='1.0'>") handleOrTLSCtx
put $ state { stateAuthenticationState = AuthenticatedUnbound userName resource }
return Nothing
IEE EnumeratorDone ->
-- TODO: Exit?
return Nothing
-- ---------------------------------------------------------------------------
-- XML EVENTS
-- ---------------------------------------------------------------------------
-- Ignore id="bind_1" and session IQ result, otherwise create client event
IEE (EnumeratorXML (XEIQ iqEvent)) ->
case shouldIgnoreIQ iqEvent of
True ->
return Nothing
False -> do
let stanzaID' = iqID iqEvent
let newTimeouts = case stanzaID' of
Just stanzaID'' ->
case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
False -> (stateTimeoutStanzaIDs state)
Nothing -> (stateTimeoutStanzaIDs state)
let iqReceivedFunctions = map (\ x -> iqReceived x) (stateClientHandlers state)
let functions = map (\ x -> case x of
Just f -> Just (f iqEvent)
Nothing -> Nothing) iqReceivedFunctions
let functions' = case lookup (fromJust $ iqID $ iqEvent) (stateIQCallbacks state) of
Just f -> (Just (f $ iqEvent)):functions
Nothing -> functions
let clientState = stateClientState state
clientState' <- sendToClient functions' clientState
put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
return Nothing
IEE (EnumeratorXML (XEPresence presenceEvent)) -> do
let stanzaID' = presenceID $ presenceEvent
let newTimeouts = case stanzaID' of
Just stanzaID'' ->
case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
False -> (stateTimeoutStanzaIDs state)
Nothing -> (stateTimeoutStanzaIDs state)
let presenceReceivedFunctions = map (\ x -> presenceReceived x) (stateClientHandlers state)
let functions = map (\ x -> case x of
Just f -> Just (f presenceEvent)
Nothing -> Nothing) presenceReceivedFunctions
let clientState = stateClientState state -- ClientState s m
clientState' <- sendToClient functions clientState
put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
return Nothing
IEE (EnumeratorXML (XEMessage messageEvent)) -> do
let stanzaID' = messageID $ messageEvent
let newTimeouts = case stanzaID' of
Just stanzaID'' ->
case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
False -> (stateTimeoutStanzaIDs state)
Nothing -> (stateTimeoutStanzaIDs state)
let messageReceivedFunctions = map (\ x -> messageReceived x) (stateClientHandlers state)
let functions = map (\ x -> case x of
Just f -> Just (f messageEvent)
Nothing -> Nothing) messageReceivedFunctions
let clientState = stateClientState state -- ClientState s m
clientState' <- sendToClient functions clientState
put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
return Nothing
IEC (CEPresence presence stanzaCallback timeoutCallback streamErrorCallback) -> do
presence' <- case presenceID $ presence of
Nothing -> do
id <- liftIO $ nextID $ stateIDGenerator state
return $ presence { presenceID = Just (SID id) }
_ -> return presence
case timeoutCallback of
Just (t, timeoutCallback') ->
let stanzaID' = (fromJust $ presenceID $ presence') in do
registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
Nothing ->
return ()
let xml = presenceToXML presence'
lift $ liftIO $ send xml handleOrTLSCtx
return Nothing
IEC (CEMessage message stanzaCallback timeoutCallback streamErrorCallback) -> do
message' <- case messageID message of
Nothing -> do
id <- liftIO $ nextID $ stateIDGenerator state
return $ message { messageID = Just (SID id) }
_ -> return message
case timeoutCallback of
Just (t, timeoutCallback') ->
let stanzaID' = (fromJust $ messageID message') in do
registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
Nothing ->
return ()
let xml = messageToXML message'
lift $ liftIO $ send xml handleOrTLSCtx
return Nothing
IEC (CEIQ iq stanzaCallback timeoutCallback stanzaErrorCallback) -> do
iq' <- case iqID iq of
Nothing -> do
id <- liftIO $ nextID $ stateIDGenerator state
return $ case iq of
IQReq r -> do
IQReq (r { iqRequestID = Just (SID id) })
IQRes r -> do
IQRes (r { iqResponseID = Just (SID id) })
_ -> return iq
case stanzaCallback of
Just callback' -> case iq of
IQReq {} -> put $ state { stateIQCallbacks = (fromJust $ iqID iq, callback'):(stateIQCallbacks state) }
_ -> return ()
Nothing -> return ()
case timeoutCallback of
Just (t, timeoutCallback') ->
let stanzaID' = (fromJust $ iqID iq') in do
registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
Nothing ->
return ()
-- TODO: Bind ID to callback
let xml = iqToXML iq'
lift $ liftIO $ send xml handleOrTLSCtx
return Nothing
IEC (CEAction predicate callback) -> do
case predicate of
Just predicate' -> do
result <- runBoolClientCallback predicate'
case result of
True -> do
runUnitClientCallback callback
return Nothing
False -> return Nothing
Nothing -> do
runUnitClientCallback callback
return Nothing
-- XOEDisconnect -> do
-- -- TODO: Close stream
-- return ()
IET (TimeoutEvent i t c) ->
case i `elem` (stateTimeoutStanzaIDs state) of
True -> do
runUnitClientCallback c
return Nothing
False -> return Nothing
e -> do
return Nothing
-- lift $ liftIO $ putStrLn $ "UNCAUGHT EVENT: " ++ (show e)
-- return $ Just (CE.SomeException $ CE.PatternMatchFail "processEvent")
where
-- Assumes handle is set
send :: String -> Either Handle TLSCtx -> IO ()
send s o = case o of
Left handle -> do
liftIO $ hPutStr handle $ encodeString $ s
liftIO $ hFlush handle
return ()
Right tlsCtx -> do
liftIO $ sendData tlsCtx $ DBLC.pack $ encodeString s
return ()
shouldIgnoreIQ :: IQ -> Bool
shouldIgnoreIQ i = case iqPayload i of
Nothing -> False
Just e -> case nameNamespace $ elementName e of
Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-bind" -> True
Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-session" -> True
Just _ -> False
Nothing -> False
registerTimeout :: (ClientState s m, MonadIO m) => Chan (InternalEvent s m) -> StanzaID -> Timeout -> StateT s m () -> StateT (State s m) m ()
registerTimeout ch i t ca = do
liftIO $ threadDelay $ t * 1000
liftIO $ forkIO $ writeChan ch $ IET (TimeoutEvent i t ca)
return ()
runBoolClientCallback :: (ClientState s m, MonadIO m) => StateT s m Bool -> StateT (State s m) m Bool
runBoolClientCallback c = do
state <- get
let clientState = stateClientState state
(bool, clientState') <- lift $ runStateT c clientState
put $ state { stateClientState = clientState' }
return bool
runUnitClientCallback :: (ClientState s m, MonadIO m) => StateT s m () -> StateT (State s m) m ()
runUnitClientCallback c = do
state <- get
let clientState = stateClientState state
((), clientState') <- lift $ runStateT c clientState
put $ state { stateClientState = clientState' }
sendToClient :: (MonadIO m, ClientState s m) => [Maybe (StateT s m Bool)] -> s -> (StateT (State s m) m) s
sendToClient [] s = return s
sendToClient (Nothing:fs) s = sendToClient fs s
sendToClient ((Just f):fs) s = do
(b, s') <- lift $ runStateT f s
case b of
True -> return s'
False -> sendToClient fs s'

182
Network/XMPP/Stanza.hs
Unescape View File

@ -0,0 +1,182 @@ @@ -0,0 +1,182 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- |
-- Module: $Header$
-- Description: XMPP stanza types and utility functions
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
--
-- The stanza record types are generally pretty convenient to work with.
-- However, due to the fact that an "IQ" can be both an "IQRequest" and an
-- "IQResponse" we provide some helper functions in this module that work on
-- both types.
--
-- We also provide functions to create a new stanza ID generator, and to
-- generate new IDs.
module Network.XMPP.Stanza (
iqID,
iqFrom,
iqTo,
iqXMLLang,
iqPayload,
iqPayloadNamespace,
iqRequestPayloadNamespace,
iqResponsePayloadNamespace,
idGenerator,
nextID
) where
import Network.XMPP.Address
import Network.XMPP.Types
import Data.IORef (atomicModifyIORef, newIORef)
import Data.XML.Types (Element, elementName, nameNamespace)
import Data.Text (unpack)
-- |
-- Returns the @StanzaID@ value of the @IQ@, if any.
iqID :: IQ -> Maybe StanzaID
iqID (IQReq i) = iqRequestID i
iqID (IQRes i) = iqResponseID i
-- |
-- Returns the @From@ @JID@ value of the @IQ@, if any.
iqFrom :: IQ -> Maybe From
iqFrom (IQReq i) = iqRequestFrom i
iqFrom (IQRes i) = iqResponseFrom i
-- |
-- Returns the @To@ @JID@ value of the @IQ@, if any.
iqTo :: IQ -> Maybe To
iqTo (IQReq i) = iqRequestTo i
iqTo (IQRes i) = iqResponseTo i
-- |
-- Returns the @XMLLang@ value of the @IQ@, if any.
iqXMLLang :: IQ -> Maybe XMLLang
iqXMLLang (IQReq i) = iqRequestXMLLang i
iqXMLLang (IQRes i) = iqResponseXMLLang i
-- |
-- Returns the @Element@ payload value of the @IQ@, if any. If the IQ in
-- question is of the "request" type, use @iqRequestPayload@ instead.
iqPayload :: IQ -> Maybe Element
iqPayload (IQReq i) = Just (iqRequestPayload i)
iqPayload (IQRes i) = iqResponsePayload i
-- |
-- Returns the namespace of the element of the @IQ@, if any.
iqPayloadNamespace :: IQ -> Maybe String
iqPayloadNamespace i = case iqPayload i of
Nothing -> Nothing
Just p -> case nameNamespace $ elementName p of
Nothing -> Nothing
Just n -> Just (unpack n)
-- |
-- Returns the namespace of the element of the @IQRequest@, if any.
iqRequestPayloadNamespace :: IQRequest -> Maybe String
iqRequestPayloadNamespace i = let p = iqRequestPayload i in
case nameNamespace $ elementName p of
Nothing -> Nothing
Just n -> Just (unpack n)
-- |
-- Returns the namespace of the element of the @IQRequest@, if any.
iqResponsePayloadNamespace :: IQResponse -> Maybe String
iqResponsePayloadNamespace i = case iqResponsePayload i of
Nothing -> Nothing
Just p -> case nameNamespace $ elementName p of
Nothing -> Nothing
Just n -> Just (unpack n)
-- |
-- Creates a new stanza "IDGenerator". Internally, it will maintain an infinite
-- list of stanza IDs ('[\'a\', \'b\', \'c\'...]').
idGenerator :: String -> IO IDGenerator
idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IDGenerator ioRef
-- |
-- Extracts an ID from the "IDGenerator", and updates the generators internal
-- state so that the same ID will not be generated again.
nextID :: IDGenerator -> IO String
nextID g = let IDGenerator ioRef = g
in atomicModifyIORef ioRef (\ (i:is) -> (is, i))
-- Generates an infinite and predictable list of IDs, all beginning with the
-- provided prefix.
ids :: String -> [String]
-- Adds the prefix to all combinations of IDs (ids').
ids p = map (\ id -> p ++ id) ids'
where
-- Generate all combinations of IDs, with increasing length.
ids' :: [String]
ids' = concatMap ids'' [1..]
-- Generates all combinations of IDs with the given length.
ids'' :: Integer -> [String]
ids'' 0 = [""]
ids'' l = [x:xs | x <- repertoire, xs <- ids'' (l - 1)]
-- Characters allowed in IDs.
repertoire :: String
repertoire = ['a'..'z']

457
Network/XMPP/Stream.hs
Unescape View File

@ -0,0 +1,457 @@ @@ -0,0 +1,457 @@
-----------------------------------------------------------------------------
--
-- Module : Network.XMPP.Stream
-- Copyright : Copyright © 2011, Jon Kristensen
-- License : UnknownLicense "LGPL3"
--
-- Maintainer : jon.kristensen@pontarius.org
-- Stability : alpha
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
module Network.XMPP.Stream (
isTLSSecured,
xmlEnumerator,
xmlReader,
presenceToXML,
iqToXML,
messageToXML,
parsePresence,
parseIQ,
parseMessage
) where
import Network.XMPP.Address hiding (fromString)
import qualified Network.XMPP.Address as X
import Network.XMPP.Types
import Network.XMPP.Utilities
import Network.XMPP.TLS
import Network.XMPP.Stanza
import qualified Control.Exception as CE
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)
import Network.TLS
import Network.TLS.Cipher
import Data.Enumerator (($$), Iteratee, continue, joinI,
run, run_, yield)
import Data.Enumerator.Binary (enumHandle, enumFile)
import Text.XML.Enumerator.Parse (parseBytes, decodeEntities)
import Text.XML.Enumerator.Document (fromEvents)
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null)
import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack)
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import qualified Data.List as DL
import qualified Data.Text as DT
import qualified Data.Text.Lazy as DTL
import Data.Maybe
import Data.XML.Types
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.String (IsString(..))
isTLSSecured :: TLSState -> Bool
isTLSSecured (PostHandshake _) = True
isTLSSecured _ = False
-- Reads from the provided handle or TLS context and sends the events to the
-- internal event channel.
xmlEnumerator :: Chan (InternalEvent s m) -> Either Handle TLSCtx -> IO ()
xmlEnumerator c s = do
enumeratorResult <- case s of
Left handle -> run $ enumHandle 1 handle $$ joinI $
parseBytes decodeEntities $$ xmlReader c
Right tlsCtx -> run $ enumTLS tlsCtx $$ joinI $
parseBytes decodeEntities $$ xmlReader c
case enumeratorResult of
Right _ ->
writeChan c $ IEE EnumeratorDone
Left e ->
writeChan c $ IEE (EnumeratorException e)
where
-- Behaves like enumHandle, but reads from the TLS context instead
enumTLS :: TLSCtx -> E.Enumerator DB.ByteString IO b
enumTLS c s = loop c s
loop :: TLSCtx -> E.Step DB.ByteString IO b -> E.Iteratee DB.ByteString IO b
loop c (E.Continue k) = do
d <- recvData c
case DBL.null d of
True -> loop c (E.Continue k)
False -> k (E.Chunks $ DBL.toChunks d) E.>>== loop c
loop _ step = E.returnI step
xmlReader :: Chan (InternalEvent s m) -> Iteratee Event IO (Maybe Event)
xmlReader c = xmlReader_ c [] 0
xmlReader_ :: Chan (InternalEvent s m) -> [Event] -> Int ->
Iteratee Event IO (Maybe Event)
xmlReader_ ch [EventBeginDocument] 0 = xmlReader_ ch [] 0
-- TODO: Safe to start change level here? We are doing this since the stream can
-- restart.
-- TODO: l < 2?
xmlReader_ ch [EventBeginElement name attribs] l
| l < 3 && nameLocalName name == DT.pack "stream" &&
namePrefix name == Just (DT.pack "stream") = do
liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEBeginStream $ "StreamTODO"
xmlReader_ ch [] 1
xmlReader_ ch [EventEndElement name] 1
| namePrefix name == Just (DT.pack "stream") &&
nameLocalName name == DT.pack "stream" = do
liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEEndStream
return Nothing
-- Check if counter is one to forward it to related function.
-- Should replace "reverse ((EventEndElement n):es)" with es
-- ...
xmlReader_ ch ((EventEndElement n):es) 1
| nameLocalName n == DT.pack "proceed" = do
liftIO $ writeChan ch $ IEE $ EnumeratorXML $ XEProceed
E.yield Nothing (E.Chunks [])
| otherwise = do
-- liftIO $ putStrLn "Got an IEX Event..."
liftIO $ writeChan ch $ IEE $ EnumeratorXML $ (processEventList (DL.reverse ((EventEndElement n):es)))
xmlReader_ ch [] 1
-- Normal condition, buffer the event to events list.
xmlReader_ ch es co = do
head <- EL.head
let co' = counter co head
-- liftIO $ putStrLn $ show co' ++ "\t" ++ show head -- for test
case head of
Just e -> xmlReader_ ch (e:es) co'
Nothing -> xmlReader_ ch es co'
-- TODO: Generate real event.
processEventList :: [Event] -> XMLEvent
processEventList e
| namePrefix name == Just (DT.pack "stream") &&
nameLocalName name == DT.pack "features" = XEFeatures "FeaturesTODO"
| nameLocalName name == DT.pack "challenge" =
let EventContent (ContentText c) = head es in XEChallenge $ Chal $ DT.unpack c
| nameLocalName name == DT.pack "success" =
let EventContent (ContentText c) = head es in XESuccess $ Succ $ "" -- DT.unpack c
| nameLocalName name == DT.pack "iq" = XEIQ $ parseIQ $ eventsToElement e
| nameLocalName name == DT.pack "presence" = XEPresence $ parsePresence $ eventsToElement e
| nameLocalName name == DT.pack "message" = XEMessage $ parseMessage $ eventsToElement e
| otherwise = XEOther $ elementToString $ Just (eventsToElement e)
where
(EventBeginElement name attribs) = head e
es = tail e
eventsToElement :: [Event] -> Element
eventsToElement e = do
documentRoot $ fromJust (run_ $ enum e $$ fromEvents)
where
enum :: [Event] -> E.Enumerator Event Maybe Document
enum e_ (E.Continue k) = k $ E.Chunks e_
enum e_ step = E.returnI step
counter :: Int -> Maybe Event -> Int
counter c (Just (EventBeginElement _ _)) = (c + 1)
counter c (Just (EventEndElement _) ) = (c - 1)
counter c _ = c
presenceToXML :: Presence -> String
presenceToXML p = "<presence" ++ from ++ id' ++ to ++ type' ++ ">" ++
(elementsToString $ presencePayload p) ++ "</presence>"
where
from :: String
from = case presenceFrom p of
-- TODO: Lower-case
Just s -> " from='" ++ (show s) ++ "'"
Nothing -> ""
id' :: String
id' = case presenceID p of
Just (SID s) -> " id='" ++ s ++ "'"
Nothing -> ""
to :: String
to = case presenceTo p of
-- TODO: Lower-case
Just s -> " to='" ++ (show s) ++ "'"
Nothing -> ""
type' :: String
type' = case presenceType p of
Available -> ""
t -> " type='" ++ (presenceTypeToString t) ++ "'"
iqToXML :: IQ -> String
iqToXML (IQReq (IQGet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) =
let type' = " type='get'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString (Just p)) ++ "</iq>"
where
from :: String
from = case f of
-- TODO: Lower-case
Just s -> " from='" ++ (show s) ++ "'"
Nothing -> ""
id' :: String
id' = case i of
Just (SID s) -> " id='" ++ s ++ "'"
Nothing -> ""
to :: String
to = case t of
-- TODO: Lower-case
Just s -> " to='" ++ (show s) ++ "'"
Nothing -> ""
iqToXML (IQReq (IQSet { iqRequestID = i, iqRequestPayload = p, iqRequestFrom = f, iqRequestTo = t })) =
let type' = " type='set'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString (Just p)) ++ "</iq>"
where
from :: String
from = case f of
-- TODO: Lower-case
Just s -> " from='" ++ (show s) ++ "'"
Nothing -> ""
id' :: String
id' = case i of
Just (SID s) -> " id='" ++ s ++ "'"
Nothing -> ""
to :: String
to = case t of
-- TODO: Lower-case
Just s -> " to='" ++ (show s) ++ "'"
Nothing -> ""
iqToXML (IQRes (IQResult { iqResponseID = i, iqResponsePayload = p, iqResponseFrom = f, iqResponseTo = t })) =
let type' = " type='result'" in "<iq" ++ from ++ id' ++ to ++ type' ++ ">" ++ (elementToString p) ++ "</iq>"
where
from :: String
from = case f of
-- TODO: Lower-case
Just s -> " from='" ++ (show s) ++ "'"
Nothing -> ""
id' :: String
id' = case i of
Just (SID s) -> " id='" ++ s ++ "'"
Nothing -> ""
to :: String
to = case t of
-- TODO: Lower-case
Just s -> " to='" ++ (show s) ++ "'"
Nothing -> ""
-- TODO: Turn message errors into XML.
messageToXML :: Message -> String
messageToXML Message { messageID = i, messageFrom = f, messageTo = t, messagePayload = p, messageType = ty } = "<message" ++ from ++ id' ++ to ++ type' ++ ">" ++
(elementsToString $ p) ++ "</message>"
where
from :: String
from = case f of
-- TODO: Lower-case
Just s -> " from='" ++ (show s) ++ "'"
Nothing -> ""
id' :: String
id' = case i of
Just (SID s) -> " id='" ++ s ++ "'"
Nothing -> ""
to :: String
to = case t of
-- TODO: Lower-case
Just s -> " to='" ++ (show s) ++ "'"
Nothing -> ""
type' :: String
type' = case ty of
Normal -> ""
t -> " type='" ++ (messageTypeToString t) ++ "'"
parseIQ :: Element -> IQ
parseIQ e | typeAttr == "get" = let (Just payloadMust) = payload
in IQReq (IQGet idAttr fromAttr toAttr Nothing
payloadMust)
| typeAttr == "set" = let (Just payloadMust) = payload
in IQReq (IQSet idAttr fromAttr toAttr Nothing
payloadMust)
| typeAttr == "result" = IQRes (IQResult idAttr fromAttr toAttr
Nothing payload)
where
-- TODO: Many duplicate functions from parsePresence.
payload :: Maybe Element
payload = case null (elementChildren e) of
True -> Nothing
False -> Just $ head $ elementChildren e
typeAttr :: String
typeAttr = case attributeText typeName e of
-- Nothing -> Nothing
Just a -> DT.unpack a
fromAttr :: Maybe Address
fromAttr = case attributeText fromName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
toAttr :: Maybe Address
toAttr = case attributeText toName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
idAttr :: Maybe StanzaID
idAttr = case attributeText idName e of
Nothing -> Nothing
Just a -> Just (SID (DT.unpack a))
typeName :: Name
typeName = fromString "type"
fromName :: Name
fromName = fromString "from"
toName :: Name
toName = fromString "to"
idName :: Name
idName = fromString "id"
-- TODO: Parse xml:lang
parsePresence :: Element -> Presence
parsePresence e = Presence idAttr fromAttr toAttr Nothing typeAttr (elementChildren e)
where
-- TODO: Many duplicate functions from parseIQ.
typeAttr :: PresenceType
typeAttr = case attributeText typeName e of
Just t -> stringToPresenceType $ DT.unpack t
Nothing -> Available
fromAttr :: Maybe Address
fromAttr = case attributeText fromName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
toAttr :: Maybe Address
toAttr = case attributeText toName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
idAttr :: Maybe StanzaID
idAttr = case attributeText idName e of
Nothing -> Nothing
Just a -> Just (SID (DT.unpack a))
fromName :: Name
fromName = fromString "from"
typeName :: Name
typeName = fromString "type"
toName :: Name
toName = fromString "to"
idName :: Name
idName = fromString "id"
parseMessage :: Element -> Message
parseMessage e = Message idAttr fromAttr toAttr Nothing typeAttr (elementChildren e)
where
-- TODO: Many duplicate functions from parseIQ.
typeAttr :: MessageType
typeAttr = case attributeText typeName e of
Just t -> stringToMessageType $ DT.unpack t
Nothing -> Normal
fromAttr :: Maybe Address
fromAttr = case attributeText fromName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
toAttr :: Maybe Address
toAttr = case attributeText toName e of
Nothing -> Nothing
Just a -> X.fromString $ DT.unpack a
idAttr :: Maybe StanzaID
idAttr = case attributeText idName e of
Nothing -> Nothing
Just a -> Just (SID (DT.unpack a))
fromName :: Name
fromName = fromString "from"
typeName :: Name
typeName = fromString "type"
toName :: Name
toName = fromString "to"
idName :: Name
idName = fromString "id"
-- stringToPresenceType "available" = Available
-- stringToPresenceType "away" = Away
-- stringToPresenceType "chat" = Chat
-- stringToPresenceType "dnd" = DoNotDisturb
-- stringToPresenceType "xa" = ExtendedAway
stringToPresenceType "available" = Available -- TODO: Some client sent this
stringToPresenceType "probe" = Probe
-- stringToPresenceType "error" = PresenceError -- TODO: Special case
stringToPresenceType "unavailable" = Unavailable
stringToPresenceType "subscribe" = Subscribe
stringToPresenceType "subscribed" = Subscribed
stringToPresenceType "unsubscribe" = Unsubscribe
stringToPresenceType "unsubscribed" = Unsubscribed
-- presenceTypeToString Available = "available"
-- presenceTypeToString Away = "away"
-- presenceTypeToString Chat = "chat"
-- presenceTypeToString DoNotDisturb = "dnd"
-- presenceTypeToString ExtendedAway = "xa"
presenceTypeToString Unavailable = "unavailable"
presenceTypeToString Probe = "probe"
-- presenceTypeToString PresenceError = "error" -- TODO: Special case
presenceTypeToString Subscribe = "subscribe"
presenceTypeToString Subscribed = "subscribed"
presenceTypeToString Unsubscribe = "unsubscribe"
presenceTypeToString Unsubscribed = "unsubscribed"
stringToMessageType "chat" = Chat
stringToMessageType "error" = Error
stringToMessageType "groupchat" = Groupchat
stringToMessageType "headline" = Headline
stringToMessageType "normal" = Normal
stringToMessageType s = OtherMessageType s
messageTypeToString Chat = "chat"
messageTypeToString Error = "error"
messageTypeToString Groupchat = "groupchat"
messageTypeToString Headline = "headline"
messageTypeToString Normal = "normal"
messageTypeToString (OtherMessageType s) = s

47
Network/XMPP/TLS.hs
Unescape View File

@ -0,0 +1,47 @@ @@ -0,0 +1,47 @@
-----------------------------------------------------------------------------
--
-- Module : Network.XMPP.TLS
-- Copyright : Copyright © 2011, Jon Kristensen
-- License : LGPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer : jon.kristensen@pontarius.org
-- Stability : alpha
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
module Network.XMPP.TLS (
getTLSParams,
handshake'
) where
import Network.TLS
import Network.TLS.Cipher
import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)
getTLSParams :: TLSParams
getTLSParams = TLSParams { pConnectVersion = TLS10
, pAllowedVersions = [TLS10,TLS11]
, pCiphers = [cipher_AES256_SHA1] -- Check the rest
, pCompressions = [nullCompression]
, pWantClientCert = False
, pCertificates = []
, onCertificatesRecv = \_ -> return True } -- Verify cert chain
handshake' :: Handle -> String -> IO (Maybe TLSCtx)
handshake' h s = do
let t = getTLSParams
r <- makeSRandomGen
case r of
Right sr -> do
putStrLn $ show sr
c <- client t sr h
handshake c
putStrLn ">>>>TLS data sended<<<<"
return (Just c)
Left ge -> do
putStrLn $ show ge
return Nothing

457
Network/XMPP/Types.hs
Unescape View File

@ -0,0 +1,457 @@ @@ -0,0 +1,457 @@
-----------------------------------------------------------------------------
--
-- Module : Types
-- Copyright : Copyright © 2011, Jon Kristensen
-- License : LGPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer : jon.kristensen@pontarius.org
-- Stability : alpha
-- Portability :
--
-----------------------------------------------------------------------------
{-# LANGUAGE MultiParamTypeClasses #-}
module Network.XMPP.Types (
StanzaID (..),
From,
To,
IQ (..),
IQRequest (..),
IQResponse (..),
Message (..),
MessageType (..),
Presence (..),
PresenceType (..),
StanzaError (..),
StanzaErrorType (..),
StanzaErrorCondition (..),
HostName
, Password
, PortNumber
, Resource
, UserName,
EnumeratorEvent (..),
Challenge (..),
Success (..),
TLSState (..),
Address (..),
Localpart,
Serverpart,
Resourcepart,
XMLLang,
InternalEvent (..),
XMLEvent (..),
ConnectionState (..),
ClientEvent (..),
StreamState (..),
AuthenticationState (..),
Certificate,
ConnectResult (..),
OpenStreamResult (..),
SecureWithTLSResult (..),
AuthenticateResult (..),
ServerAddress (..),
XMPPError (..),
Timeout,
TimeoutEvent (..),
StreamError (..),
IDGenerator (..)
) where
import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)
import qualified Network as N
import qualified Control.Exception as CE
import Control.Monad.State hiding (State)
import Data.XML.Types
import Network.TLS
import Network.TLS.Cipher
import qualified Control.Monad.Error as CME
import Data.IORef
-- =============================================================================
-- STANZA TYPES
-- =============================================================================
-- TODO: Would a Stanza class such as the one below be useful sometimes?
--
-- class Stanza a where
-- stanzaID :: a -> Maybe StanzaID
-- stanzaFrom :: a -> Maybe From
-- stanzaTo :: a -> Maybe To
-- stanzaXMLLang :: a -> Maybe XMLLang
-- |
-- The StanzaID type wraps a string of random characters that in Pontarius XMPP
-- is guaranteed to be unique for the XMPP session. Clients can add a string
-- prefix for the IDs to guarantee that they are unique in a larger context by
-- specifying the stanzaIDPrefix setting. TODO
data StanzaID = SID String deriving (Eq, Show)
-- |
-- @From@ is a readability type synonym for @Address@.
type From = Address
-- |
-- @To@ is a readability type synonym for @Address@.
type To = Address
-- |
-- An Info/Query (IQ) stanza is either of the type "request" ("get" or "set") or
-- "response" ("result" or "error"). The @IQ@ type wraps these two sub-types.
data IQ = IQReq IQRequest | IQRes IQResponse deriving (Eq, Show)
-- |
-- A "request" Info/Query (IQ) stanza is one with either "get" or "set" as type.
-- They are guaranteed to always contain a payload.
data IQRequest = IQGet { iqRequestID :: Maybe StanzaID
, iqRequestFrom :: Maybe From
, iqRequestTo :: Maybe To
, iqRequestXMLLang :: Maybe XMLLang
, iqRequestPayload :: Element } |
IQSet { iqRequestID :: Maybe StanzaID
, iqRequestFrom :: Maybe From
, iqRequestTo :: Maybe To
, iqRequestXMLLang :: Maybe XMLLang
, iqRequestPayload :: Element }
deriving (Eq, Show)
-- |
-- A "response" Info/Query (IQ) stanza is one with either "result" or "error" as
-- type.
data IQResponse = IQResult { iqResponseID :: Maybe StanzaID
, iqResponseFrom :: Maybe From
, iqResponseTo :: Maybe To
, iqResponseXMLLang :: Maybe XMLLang
, iqResponsePayload :: Maybe Element } |
IQError { iqResponseID :: Maybe StanzaID
, iqResponseFrom :: Maybe From
, iqResponseTo :: Maybe To
, iqResponseXMLLang :: Maybe XMLLang
, iqResponsePayload :: Maybe Element
, iqResponseStanzaError :: StanzaError }
deriving (Eq, Show)
-- |
-- The message stanza - either a message or a message error.
data Message = Message { messageID :: Maybe StanzaID
, messageFrom :: Maybe From
, messageTo :: Maybe To
, messageXMLLang :: Maybe XMLLang
, messageType :: MessageType
, messagePayload :: [Element] } |
MessageError { messageID :: Maybe StanzaID
, messageFrom :: Maybe From
, messageTo :: Maybe To
, messageXMLLang :: Maybe XMLLang
, messageErrorPayload :: Maybe [Element]
, messageErrorStanzaError :: StanzaError }
deriving (Eq, Show)
-- |
-- @MessageType@ holds XMPP message types as defined in XMPP-IM. @Normal@ is the
-- default message type.
data MessageType = Chat |
Error |
Groupchat |
Headline |
Normal |
OtherMessageType String deriving (Eq, Show)
-- |
-- The presence stanza - either a presence or a presence error.
data Presence = Presence { presenceID :: Maybe StanzaID
, presenceFrom :: Maybe From
, presenceTo :: Maybe To
, presenceXMLLang :: Maybe XMLLang
, presenceType :: PresenceType
, presencePayload :: [Element] } |
PresenceError { presenceID :: Maybe StanzaID
, presenceFrom :: Maybe From
, presenceTo :: Maybe To
, presenceXMLLang :: Maybe XMLLang
, presenceErrorPayload :: Maybe [Element]
, presenceErrorStanzaError :: StanzaError }
deriving (Eq, Show)
-- |
-- @PresenceType@ holds XMPP presence types. When a presence type is not
-- provided, we assign the @PresenceType@ value @Available@.
data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence
Subscribed | -- ^ Sender has approved the subscription
Unsubscribe | -- ^ Sender is unsubscribing from presence
Unsubscribed | -- ^ Sender has denied or cancelled a
-- subscription
Probe | -- ^ Sender requests current presence;
-- should only be used by servers
Available | -- ^ Sender did not specify a type attribute
Unavailable deriving (Eq, Show)
-- |
-- All stanzas (IQ, message, presence) can cause errors, which in the XMPP
-- stream looks like <stanza-kind to='sender' type='error'>. These errors are
-- wrapped in the @StanzaError@ type.
data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType
, stanzaErrorCondition :: StanzaErrorCondition
, stanzaErrorText :: Maybe String
, stanzaErrorApplicationSpecificCondition ::
Maybe Element } deriving (Eq, Show)
-- |
-- @StanzaError@s always have one of these types.
data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry
Continue | -- ^ Conditition was a warning - proceed
Modify | -- ^ Change the data and retry
Auth | -- ^ Provide credentials and retry
Wait -- ^ Error is temporary - wait and retry
deriving (Eq, Show)
-- |
-- Stanza errors are accommodated with one of the error conditions listed below.
data StanzaErrorCondition = BadRequest | -- ^ Malformed XML
Conflict | -- ^ Resource or session
-- with name already
-- exists
FeatureNotImplemented |
Forbidden | -- ^ Insufficient
-- permissions
Gone | -- ^ Entity can no longer
-- be contacted at this
-- address
InternalServerError |
ItemNotFound |
JIDMalformed |
NotAcceptable | -- ^ Does not meet policy
-- criteria
NotAllowed | -- ^ No entity may perform
-- this action
NotAuthorized | -- ^ Must provide proper
-- credentials
PaymentRequired |
RecipientUnavailable | -- ^ Temporarily
-- unavailable
Redirect | -- ^ Redirecting to other
-- entity, usually
-- temporarily
RegistrationRequired |
RemoteServerNotFound |
RemoteServerTimeout |
ResourceConstraint | -- ^ Entity lacks the
-- necessary system
-- resources
ServiceUnavailable |
SubscriptionRequired |
UndefinedCondition | -- ^ Application-specific
-- condition
UnexpectedRequest -- ^ Badly timed request
deriving (Eq, Show)
-- =============================================================================
-- OTHER STUFF
-- =============================================================================
instance Eq ConnectionState where
Disconnected == Disconnected = True
(Connected p h) == (Connected p_ h_) = p == p_ && h == h_
-- (ConnectedPostFeatures s p h t) == (ConnectedPostFeatures s p h t) = True
-- (ConnectedAuthenticated s p h t) == (ConnectedAuthenticated s p h t) = True
_ == _ = False
data XMPPError = UncaughtEvent deriving (Eq, Show)
instance CME.Error XMPPError where
strMsg "UncaughtEvent" = UncaughtEvent
-- | Readability type for host name Strings.
type HostName = String -- This is defined in Network as well
-- | Readability type for port number Integers.
type PortNumber = Integer -- We use N(etwork).PortID (PortNumber) internally
-- | Readability type for user name Strings.
type UserName = String
-- | Readability type for password Strings.
type Password = String
-- | Readability type for (Address) resource identifier Strings.
type Resource = String
-- An XMLEvent is triggered by an XML stanza or some other XML event, and is
-- sent through the internal event channel, just like client action events.
data XMLEvent = XEBeginStream String | XEFeatures String |
XEChallenge Challenge | XESuccess Success |
XEEndStream | XEIQ IQ | XEPresence Presence |
XEMessage Message | XEProceed |
XEOther String deriving (Show)
data EnumeratorEvent = EnumeratorDone |
EnumeratorXML XMLEvent |
EnumeratorException CE.SomeException
deriving (Show)
-- Type to contain the internal events.
data InternalEvent s m = IEC (ClientEvent s m) | IEE EnumeratorEvent | IET (TimeoutEvent s m) deriving (Show)
data TimeoutEvent s m = TimeoutEvent StanzaID Timeout (StateT s m ())
instance Show (TimeoutEvent s m) where
show (TimeoutEvent (SID i) t _) = "TimeoutEvent (ID: " ++ (show i) ++ ", timeout: " ++ (show t) ++ ")"
data StreamState = PreStream |
PreFeatures StreamProperties |
PostFeatures StreamProperties StreamFeatures
data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String String (Maybe Resource) | AuthenticatingPreChallenge2 String String (Maybe Resource) | AuthenticatingPreSuccess String String (Maybe Resource) | AuthenticatedUnbound String (Maybe Resource) | AuthenticatedBound String Resource
-- Client actions that needs to be performed in the (main) state loop are
-- converted to ClientEvents and sent through the internal event channel.
data ClientEvent s m = CEOpenStream N.HostName PortNumber
(OpenStreamResult -> StateT s m ()) |
CESecureWithTLS Certificate (Certificate -> Bool)
(SecureWithTLSResult -> StateT s m ()) |
CEAuthenticate UserName Password (Maybe Resource)
(AuthenticateResult -> StateT s m ()) |
CEMessage Message (Maybe (Message -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
CEPresence Presence (Maybe (Presence -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
CEIQ IQ (Maybe (IQ -> StateT s m Bool)) (Maybe (Timeout, StateT s m ())) (Maybe (StreamError -> StateT s m ())) |
CEAction (Maybe (StateT s m Bool)) (StateT s m ())
instance Show (ClientEvent s m) where
show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p)
show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ c
show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++
(show r)
show (CEIQ s _ _ _) = "CEIQ"
show (CEMessage s _ _ _) = "CEMessage"
show (CEPresence s _ _ _) = "CEPresence"
show (CEAction _ _) = "CEAction"
type StreamID = String
data ConnectionState = Disconnected | Connected ServerAddress Handle
data TLSState = NoTLS | PreProceed | PreHandshake | PostHandshake TLSCtx
data Challenge = Chal String deriving (Show)
data Success = Succ String deriving (Show)
type StreamProperties = Float
type StreamFeatures = String
data ConnectResult = ConnectSuccess StreamProperties StreamFeatures (Maybe Resource) |
ConnectOpenStreamFailure |
ConnectSecureWithTLSFailure |
ConnectAuthenticateFailure
data OpenStreamResult = OpenStreamSuccess StreamProperties StreamFeatures |
OpenStreamFailure
data SecureWithTLSResult = SecureWithTLSSuccess StreamProperties StreamFeatures | SecureWithTLSFailure
data AuthenticateResult = AuthenticateSuccess StreamProperties StreamFeatures Resource | AuthenticateFailure
type Certificate = String -- TODO
-- Address is a data type that has to be constructed in this module using either
-- address or stringToAddress.
data Address = Address { localpart :: Maybe Localpart
, serverpart :: Serverpart
, resourcepart :: Maybe Resourcepart }
deriving (Eq)
instance Show Address where
show (Address { localpart = n, serverpart = s, resourcepart = r })
| n == Nothing && r == Nothing = s
| r == Nothing = let Just n' = n in n' ++ "@" ++ s
| n == Nothing = let Just r' = r in s ++ "/" ++ r'
| otherwise = let Just n' = n; Just r' = r
in n' ++ "@" ++ s ++ "/" ++ r'
type Localpart = String
type Serverpart = String
type Resourcepart = String
data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq)
type Timeout = Int
data StreamError = StreamError
-- =============================================================================
-- XML TYPES
-- =============================================================================
type XMLLang = String
-- Validate, protect. See:
-- http://tools.ietf.org/html/rfc6120#section-8.1.5
-- http://www.w3.org/TR/2008/REC-xml-20081126/
-- http://www.rfc-editor.org/rfc/bcp/bcp47.txt
-- http://www.ietf.org/rfc/rfc1766.txt
newtype IDGenerator = IDGenerator (IORef [String])

93
Network/XMPP/Utilities.hs
Unescape View File

@ -0,0 +1,93 @@ @@ -0,0 +1,93 @@
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- |
-- Module: $Header$
-- Description: Utility functions for Pontarius XMPP; currently only random ID
-- generation functions
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
--
-- This module will be documented soon.
-- TODO: Document this module
-- TODO: Make is possible to customize characters
-- TODO: Make it possible to customize length
module Network.XMPP.Utilities ( elementToString
, elementsToString ) where
import Data.Word
import Data.XML.Types
import System.Crypto.Random
import System.Random
import qualified Data.ByteString as DB
import qualified Data.Map as DM
import qualified Data.Text as DT
-- =============================================================================
-- XML Utilities
-- =============================================================================
elementsToString :: [Element] -> String
elementsToString [] = ""
elementsToString (e:es) = (elementToString $ Just e) ++ elementsToString es
elementToString :: Maybe Element -> String
elementToString Nothing = ""
elementToString (Just e) = "<" ++ nameToString (elementName e) ++ xmlns ++
attributes (elementAttributes e) ++
">" ++ (nodesToString $ elementNodes e) ++ "</" ++
nameToString (elementName e) ++ ">"
where
xmlns :: String
xmlns = case nameNamespace $ elementName e of
Nothing -> ""
Just t -> " xmlns='" ++ (DT.unpack t) ++ "'"
nameToString :: Name -> String
nameToString Name { nameLocalName = n, namePrefix = Nothing } = DT.unpack n
nameToString Name { nameLocalName = n, namePrefix = Just p } =
(DT.unpack p) ++ ":" ++ (DT.unpack n)
contentToString :: Content -> String
contentToString (ContentText t) = DT.unpack t
contentToString (ContentEntity t) = DT.unpack t
attributes :: [(Name, [Content])] -> String
attributes [] = ""
attributes ((n, c):t) = (" " ++ (nameToString n) ++ "='" ++
concat (map contentToString c) ++ "'") ++
attributes t
nodesToString :: [Node] -> String
nodesToString [] = ""
nodesToString ((NodeElement e):ns) = (elementToString $ Just e) ++
(nodesToString ns)
nodesToString ((NodeContent c):ns) = (contentToString c) ++
(nodesToString ns)

22
README
Unescape View File

@ -0,0 +1,22 @@ @@ -0,0 +1,22 @@
Pontarius XMPP aims to be a secure and easy-to-use XMPP library for Haskell. We
have just released a fourth alpha version with the following features:
* Client-to-server Transport Layer Security and DIGEST-MD5 SASL Authentication
* Concurrent, Flexible and Event-based API for XMPP Client Developers
* Support for Info/Query, Presence and Message Stanzas
* Interoperable XML Parsing (Using enumerator, xml-enumerator and xml-types)
Please note that we are not recommending anyone to use Pontarius XMPP at this
time as it’s still in an experimental stage and will have its API and data types
modified. However, if you are interested to use Pontarius XMPP anyway, feel free
to contact the Pontarius project and we will try to help you get started. You
can also see the Example directory for a usage example.
We are currently working on general improvements and having the library support
all of RFC 3920: XMPP Core.
The next version, 0.1 Alpha 6, is scheduled to be released on the 6th of July.
Look at the Pontarius web site <http://www.pontarius.org/> and the Pontarius
XMPP Hackage page <http://hackage.haskell.org/package/pontarius-xmpp/> for more
information.

3
Setup.hs
Unescape View File

@ -0,0 +1,3 @@ @@ -0,0 +1,3 @@
import Distribution.Simple
main = defaultMain

69
pontarius-xmpp.cabal
Unescape View File

@ -0,0 +1,69 @@ @@ -0,0 +1,69 @@
Name: pontarius-xmpp
Version: 0.0.6.0
Cabal-Version: >= 1.6
Build-Type: Simple
License: LGPL-3
License-File: LICENSE
Copyright: Copyright © 2011, Jon Kristensen
Author: Jon Kristensen, Mahdi Abdinejadi
Maintainer: jon.kristensen@pontarius.org
Stability: alpha
Homepage: http://www.pontarius.org/
Bug-Reports: mailto:info@pontarius.org
-- Package-URL:
Synopsis: A prototyped and incomplete implementation of RFC 6120:
XMPP: Core
Description: A work in progress of an implementation of RFC 6120: XMPP:
Core, as well as RFC 6122: XMPP: Address Format and other
depending standards. A new version of Pontarius XMPP is
released every three weeks.
Category: Network
Tested-With: GHC ==7.0.2
-- Data-Files:
-- Data-Dir:
-- Extra-Source-Files:
-- Extra-Tmp-Files:
Library
Exposed-Modules: Network.XMPP, Network.XMPP.Address, Network.XMPP.SASL,
Network.XMPP.Session, Network.XMPP.Stanza,
Network.XMPP.Stream, Network.XMPP.TLS, Network.XMPP.Types,
Network.XMPP.Utilities
Exposed: True
Build-Depends: base >= 2 && < 5, parsec, enumerator, crypto-api,
base64-string, pureMD5, utf8-string, network, xml-types,
text, transformers, bytestring, binary, random,
xml-enumerator, tls ==0.4.1, containers, mtl, text-icu,
stringprep, idna2008 ==0.0.1.0
-- Other-Modules:
-- HS-Source-Dirs:
-- Extensions:
-- Build-Tools:
-- Buildable:
-- GHC-Options:
-- GHC-Prof-Options:
-- Hugs-Options:
-- NHC98-Options:
-- Includes:
-- Install-Includes:
-- Include-Dirs:
-- C-Sources:
-- Extra-Libraries:
-- Extra-Lib-Dirs:
-- CC-Options:
-- LD-Options:
-- Pkgconfig-Depends:
-- Frameworks:
Source-Repository head
Type: darcs
-- Module:
Location: https://patch-tag.com/r/jonkri/pontarius-xmpp
-- Subdir:
Source-Repository this
Type: darcs
-- Module:
Location: https://patch-tag.com/r/jonkri/pontarius-xmpp
Tag: 0.0.6.0
-- Subdir:
Write Preview
Loading…
Cancel
Save