* adds lnet subdir to fppkg for lnetpkg

git-svn-id: trunk@5802 -

.gitattributes

@@ -8186,6 +8186,26 @@ utils/fppkg/fppkg.lpi svneol=native#text/plain
 utils/fppkg/fppkg.pp svneol=native#text/plain
 utils/fppkg/fprepos.pp svneol=native#text/plain
 utils/fppkg/fpxmlrep.pp svneol=native#text/plain
+utils/fppkg/lnet/LICENSE -text
+utils/fppkg/lnet/fastcgi.pp svneol=native#text/plain
+utils/fppkg/lnet/lcommon.pp svneol=native#text/plain
+utils/fppkg/lnet/lcontainers.inc svneol=native#text/plain
+utils/fppkg/lnet/lcontainersh.inc svneol=native#text/plain
+utils/fppkg/lnet/lcontrolstack.pp svneol=native#text/plain
+utils/fppkg/lnet/levents.pp svneol=native#text/plain
+utils/fppkg/lnet/lftp.pp svneol=native#text/plain
+utils/fppkg/lnet/lnet.pp svneol=native#text/plain
+utils/fppkg/lnet/lstrbuffer.pp svneol=native#text/plain
+utils/fppkg/lnet/ltelnet.pp svneol=native#text/plain
+utils/fppkg/lnet/lwebserver.pp svneol=native#text/plain
+utils/fppkg/lnet/openssl.pp -text svneol=unset#text/plain
+utils/fppkg/lnet/sys/lepolleventer.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/lepolleventerh.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/lkqueueeventer.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/lkqueueeventerh.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/lspawnfcgiunix.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/lspawnfcgiwin.inc svneol=native#text/plain
+utils/fppkg/lnet/sys/osunits.inc svneol=native#text/plain
 utils/fppkg/pkgdownload.pp svneol=native#text/plain
 utils/fppkg/pkghandler.pp svneol=native#text/plain
 utils/fppkg/pkglibcurl.pp svneol=native#text/plain

utils/fppkg/lnet/LICENSE

@@ -0,0 +1,481 @@
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+    		    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL.  It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it.  You can use it for
+your libraries, 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
+this service 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 make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if
+you distribute copies of the library, or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library.  If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software.  To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+  Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs.  This
+license, the GNU Library General Public License, applies to certain
+designated libraries.  This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+  The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it.  Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program.  However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+  Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries.  We
+concluded that weaker conditions might promote sharing better.
+
+  However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves.  This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them.  (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.)  The hope is that this
+will lead to faster development of free libraries.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+  Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License").  Each licensee is
+addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    c) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    d) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the source code distributed need not include anything that is normally
+distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Library General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!

utils/fppkg/lnet/fastcgi.pp

@@ -0,0 +1,146 @@
+unit fastcgi;
+
+interface
+
+{
+  Automatically converted by H2Pas 0.99.16 from fastcgi.h
+  The following command line parameters were used:
+    fastcgi.h
+}
+
+{$IFDEF FPC}
+{$PACKRECORDS C}
+{$ENDIF}
+
+
+{
+ * Listening socket file number
+}
+
+const
+   FCGI_LISTENSOCK_FILENO = 0;     
+
+type
+
+   PFCGI_Header = ^FCGI_Header;
+   FCGI_Header = record
+      version : byte;
+      reqtype : byte;
+      requestIdB1 : byte;
+      requestIdB0 : byte;
+      contentLengthB1 : byte;
+      contentLengthB0 : byte;
+      paddingLength : byte;
+      reserved : byte;
+   end;
+{
+ * Number of bytes in a FCGI_Header.  Future versions of the protocol
+ * will not reduce this number.
+}
+
+const
+   FCGI_HEADER_LEN = 8;     
+
+{
+ * Value for version component of FCGI_Header
+}
+   FCGI_VERSION_1 = 1;     
+
+{
+ * Values for type component of FCGI_Header
+}
+   FCGI_BEGIN_REQUEST = 1;     
+   FCGI_ABORT_REQUEST = 2;     
+   FCGI_END_REQUEST = 3;     
+   FCGI_PARAMS = 4;     
+   FCGI_STDIN = 5;     
+   FCGI_STDOUT = 6;     
+   FCGI_STDERR = 7;     
+   FCGI_DATA = 8;     
+   FCGI_GET_VALUES = 9;     
+   FCGI_GET_VALUES_RESULT = 10;     
+   FCGI_UNKNOWN_TYPE = 11;     
+   FCGI_MAXTYPE = FCGI_UNKNOWN_TYPE;     
+   
+{
+ * Value for requestId component of FCGI_Header
+}
+   FCGI_NULL_REQUEST_ID = 0;     
+
+type
+   FCGI_BeginRequestBody = record
+      roleB1 : byte;
+      roleB0 : byte;
+      flags : byte;
+      reserved : array[0..4] of byte;
+   end;
+
+   FCGI_BeginRequestRecord = record
+      header : FCGI_Header;
+      body : FCGI_BeginRequestBody;
+   end;
+   
+{
+ * Mask for flags component of FCGI_BeginRequestBody
+}
+
+const
+   FCGI_KEEP_CONN = 1;     
+   
+{
+ * Values for role component of FCGI_BeginRequestBody
+}
+
+   FCGI_RESPONDER = 1;     
+   FCGI_AUTHORIZER = 2;     
+   FCGI_FILTER = 3;     
+
+type
+
+   FCGI_EndRequestBody = record
+      appStatusB3 : byte;
+      appStatusB2 : byte;
+      appStatusB1 : byte;
+      appStatusB0 : byte;
+      protocolStatus : byte;
+      reserved : array[0..2] of byte;
+   end;
+
+   FCGI_EndRequestRecord = record
+      header : FCGI_Header;
+      body : FCGI_EndRequestBody;
+   end;
+   
+{
+ * Values for protocolStatus component of FCGI_EndRequestBody
+}
+
+const
+   FCGI_REQUEST_COMPLETE = 0;     
+   FCGI_CANT_MPX_CONN = 1;     
+   FCGI_OVERLOADED = 2;     
+   FCGI_UNKNOWN_ROLE = 3;     
+   
+{
+ * Variable names for FCGI_GET_VALUES / FCGI_GET_VALUES_RESULT records
+}
+
+   FCGI_MAX_CONNS = 'FCGI_MAX_CONNS';     
+   FCGI_MAX_REQS = 'FCGI_MAX_REQS';     
+   FCGI_MPXS_CONNS = 'FCGI_MPXS_CONNS';     
+
+type
+
+   FCGI_UnknownTypeBody = record
+      _type : byte;
+      reserved : array[0..6] of byte;
+   end;
+
+   FCGI_UnknownTypeRecord = record
+      header : FCGI_Header;
+      body : FCGI_UnknownTypeBody;
+   end;
+
+implementation
+
+end.

utils/fppkg/lnet/lcommon.pp

@@ -0,0 +1,338 @@
+{ lCommon
+
+  CopyRight (C) 2004-2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  
+  This license has been modified. See File LICENSE.ADDON for more inFormation.
+  Should you find these sources without a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lCommon;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  {$i sys/osunits.inc}
+
+const
+  {$IFDEF WINDOWS}
+  SOL_SOCKET = $ffff;
+  LMSG = 0;
+  SOCKET_ERROR = WinSock2.SOCKET_ERROR;
+  {$ENDIF}
+
+  {$IFDEF OS2}
+  SOL_SOCKET = WinSock.SOL_SOCKET;
+  LMSG = 0;
+  SOCKET_ERROR = WinSock.SOCKET_ERROR;
+  {$ENDIF}
+
+  {$IFDEF NETWARE}
+  SOL_SOCKET = WinSock.SOL_SOCKET;
+  LMSG = 0;
+  SOCKET_ERROR = WinSock.SOCKET_ERROR;
+  {$ENDIF}
+
+  {$IFDEF UNIX}
+  INVALID_SOCKET = -1;
+  SOCKET_ERROR = -1;
+    {$IFDEF LINUX} // TODO: fix this crap, some don't even have MSD_NOSIGNAL
+    LMSG = MSG_NOSIGNAL;
+    {$ELSE}
+    LMSG = $20000; // FPC BUG in 2.0.4-
+    {$ENDIF}
+  {$ENDIF}
+  { Default Values }
+  LDEFAULT_BACKLOG = 5;
+  BUFFER_SIZE = 65536;
+  
+  { Base functions }
+  {$IFNDEF UNIX}
+  function fpSelect(const nfds: Integer; const readfds, writefds, exceptfds: PFDSet;
+                    const timeout: PTimeVal): Integer; inline;
+  function fpFD_ISSET(const Socket: Integer; var FDSet: TFDSet): Integer; inline;
+  procedure fpFD_SET(const Socket: Integer; var FDSet: TFDSet); inline;
+  procedure fpFD_ZERO(var FDSet: TFDSet); inline;
+  {$ENDIF}
+  { DNS }
+  function GetHostName(const Address: string): string;
+  function GetHostIP(const Name: string): string;
+
+  function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
+  function LSocketError: Longint;
+  
+  function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
+
+  function IsBlockError(const anError: Integer): Boolean; inline;
+
+  function TZSeconds: Integer; inline;
+
+  function StrToHostAddr(const IP: string): Cardinal; inline;
+  function HostAddrToStr(const Entry: Cardinal): string; inline;
+  function StrToNetAddr(const IP: string): Cardinal; inline;
+  function NetAddrToStr(const Entry: Cardinal): string; inline;
+  
+  procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
+                            const Address: string; const aPort: Word); inline;
+
+implementation
+
+uses
+  lNet
+  
+{$IFNDEF UNIX}
+
+{$IFDEF WINDOWS}
+  , Windows;
+
+function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
+var
+  Tmp: string;
+  TmpW: widestring;
+begin
+  Result:='[' + IntToStr(Ernum) + '] ';
+  if USEUtf8 then begin
+    SetLength(TmpW, 256);
+    SetLength(TmpW, FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or
+                                   FORMAT_MESSAGE_IGNORE_INSERTS or
+                                   FORMAT_MESSAGE_ARGUMENT_ARRAY,
+                                   nil, Ernum, 0, @TmpW[1], 256, nil));
+    Tmp:=UTF8Encode(TmpW);
+  end else begin
+    SetLength(Tmp, 256);
+    SetLength(Tmp, FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
+                                 FORMAT_MESSAGE_IGNORE_INSERTS or
+                                 FORMAT_MESSAGE_ARGUMENT_ARRAY,
+                                 nil, Ernum, 0, @Tmp[1], 256, nil));
+  end;
+  if Length(Tmp) > 2 then
+    Delete(Tmp, Length(Tmp)-1, 2);
+  Result:=Tmp;
+end;
+
+function TZSeconds: integer; inline;
+var
+  lInfo: Windows.TIME_ZONE_INFORMATION;
+begin
+  { lInfo.Bias is in minutes }
+  if Windows.GetTimeZoneInformation(@lInfo) <> $FFFFFFFF then
+    Result := lInfo.Bias * 60
+  else
+    Result := 0;
+end;
+
+{$ELSE}
+  ; // uses
+  
+function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
+begin
+  Result:=IntToStr(Ernum); // TODO: fix for non-windows winsock users
+end;
+
+function TZSeconds: integer; inline;
+begin
+  Result:=0; // todo: fix for non-windows non unix
+end;
+
+{$ENDIF}
+
+function LSocketError: Longint;
+begin
+  Result:=WSAGetLastError;
+end;
+
+function CleanError(const Ernum: Longint): Byte;
+begin
+  Result:=Byte(Ernum - 10000);
+end;
+
+function fpSelect(const nfds: Integer; const readfds, writefds, exceptfds: PFDSet;
+                  const timeout: PTimeVal): Longint; inline;
+begin
+  Result:=Select(nfds, readfds, writefds, exceptfds, timeout);
+end;
+
+function fpFD_ISSET(const Socket: Longint; var FDSet: TFDSet): Integer; inline;
+begin
+  Result:=0;
+  if FD_ISSET(Socket, FDSet) then
+    Result:=1;
+end;
+
+procedure fpFD_SET(const Socket: Longint; var FDSet: TFDSet); inline;
+begin
+  FD_SET(Socket, FDSet);
+end;
+
+procedure fpFD_ZERO(var FDSet: TFDSet); inline;
+begin
+  FD_ZERO(FDSet);
+end;
+
+function GetHostName(const Address: string): string;
+var
+  HE: PHostEnt;
+  Addr: DWord;
+begin
+  Result:='';
+  HE:=nil;
+  Addr:=inet_addr(PChar(Address));
+  HE:=gethostbyaddr(@Addr, SizeOf(Addr), AF_INET);
+  if Assigned(HE) then
+    Result:=HE^.h_name;
+end;
+
+function GetHostIP(const Name: string): string;
+var
+  HE: PHostEnt;
+  P: PDWord;
+begin
+  Result:='';
+  HE:=nil;
+  HE:=gethostbyname(PChar(Name));
+  if Assigned(HE) then begin
+    P:=Pointer(HE^.h_addr_list[0]);
+    Result:=NetAddrToStr(P^);
+  end;
+end;
+
+function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
+const
+  BlockAr: array[Boolean] of DWord = (1, 0);
+var
+  opt: DWord;
+begin
+  opt:=BlockAr[aValue];
+  if ioctlsocket(aHandle, FIONBIO, opt) = SOCKET_ERROR then
+    Exit(False);
+  Result:=True;
+end;
+
+function IsBlockError(const anError: Integer): Boolean; inline;
+begin
+  Result:=anError = WSAEWOULDBLOCK;
+end;
+
+{$ELSE}
+
+// unix
+
+  ,Errors, UnixUtil;
+
+function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
+begin
+  Result:='[' + IntToStr(Ernum) + '] ' + Errors.StrError(Ernum);
+end;
+
+function LSocketError: Longint;
+begin
+  Result:=fpgeterrno;
+end;
+
+function CleanError(const Ernum: Longint): Longint; inline;
+begin
+  Result:=Byte(Ernum);
+end;
+
+function GetHostName(const Address: string): string;
+var
+  HE: THostEntry;
+begin
+  Result:='';
+  if GetHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
+    Result:=HE.Name
+  else if ResolveHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
+    Result:=HE.Name;
+end;
+
+function GetHostIP(const Name: string): string;
+var
+  HE: THostEntry;
+begin
+  Result:='';
+  if GetHostByName(Name, HE) then
+    Result:=HostAddrToStr(Cardinal(HE.Addr)) // for localhost
+  else if ResolveHostByName(Name, HE) then
+    Result:=NetAddrToStr(Cardinal(HE.Addr));
+end;
+
+function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
+var
+  opt: cInt;
+begin
+  opt:=fpfcntl(aHandle, F_GETFL);
+  if opt = SOCKET_ERROR then
+    Exit(False);
+    
+  if aValue then
+    opt:=opt and not O_NONBLOCK
+  else
+    opt:=opt or O_NONBLOCK;
+
+  if fpfcntl(aHandle, F_SETFL, opt) = SOCKET_ERROR then
+    Exit(False);
+  Result:=True;
+end;
+
+function IsBlockError(const anError: Integer): Boolean; inline;
+begin
+  Result:=(anError = ESysEWOULDBLOCK) or (anError = ESysENOBUFS);
+end;
+
+function TZSeconds: Integer; inline;
+begin
+  Result := unixutil.TZSeconds;
+end;
+
+{$ENDIF}
+
+function StrToHostAddr(const IP: string): Cardinal; inline;
+begin
+  Result:=Cardinal(Sockets.StrToHostAddr(IP));
+end;
+
+function HostAddrToStr(const Entry: Cardinal): string; inline;
+begin
+  Result:=Sockets.HostAddrToStr(in_addr(Entry));
+end;
+
+function StrToNetAddr(const IP: string): Cardinal; inline;
+begin
+  Result:=Cardinal(Sockets.StrToNetAddr(IP));
+end;
+
+function NetAddrToStr(const Entry: Cardinal): string; inline;
+begin
+  Result:=Sockets.NetAddrToStr(in_addr(Entry));
+end;
+
+procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
+  const Address: string; const aPort: Word); inline;
+begin
+  aAddrInfo.family:=AF_INET;
+  aAddrInfo.Port:=htons(aPort);
+  aAddrInfo.Addr:=StrToNetAddr(Address);
+  
+  if (Address <> LADDR_ANY) and (aAddrInfo.Addr = 0) then
+    aAddrInfo.Addr:=StrToNetAddr(GetHostIP(Address));
+end;
+
+end.
+

utils/fppkg/lnet/lcontainers.inc

@@ -0,0 +1,50 @@
+constructor TLFront.Create(const DefaultItem: __front_type__);
+begin
+  FEmptyItem:=DefaultItem;
+  Clear;
+end;
+
+function TLFront.GetEmpty: Boolean;
+begin
+  Result:=FCount = 0;
+end;
+
+function TLFront.First: __front_type__;
+begin
+  Result:=FEmptyItem;
+  if FCount > 0 then
+    Result:=FItems[FBottom];
+end;
+
+function TLFront.Remove: __front_type__;
+begin
+  Result:=FEmptyItem;
+  if FCount > 0 then begin
+    Result:=FItems[FBottom];
+    Dec(FCount);
+    Inc(FBottom);
+    if FBottom >= MAX_FRONT_ITEMS then
+      FBottom:=0;
+  end;
+end;
+
+function TLFront.Insert(const Value: __front_type__): Boolean;
+begin
+  Result:=False;
+  if FCount < MAX_FRONT_ITEMS then begin
+    if FTop >= MAX_FRONT_ITEMS then
+      FTop:=0;
+    FItems[FTop]:=Value;
+    Inc(FCount);
+    Inc(FTop);
+    Result:=True;
+  end;
+end;
+
+procedure TLFront.Clear;
+begin
+  FCount:=0;
+  FBottom:=0;
+  FTop:=0;
+end;
+

utils/fppkg/lnet/lcontainersh.inc

@@ -0,0 +1,32 @@
+{ This include is a little a-la-templates hack
+
+  here are all the "default" type defines which you need to
+  redefine yourself after including this file. You only redefine those
+  which are used ofcourse }
+
+{$ifndef __front_type__}
+  {$ERROR Undefined type for quasi-template!}
+{$endif}
+
+const
+  MAX_FRONT_ITEMS = 10;
+
+type
+  TLFront = class // it's a queue ladies and gents
+   protected
+    FEmptyItem: __front_type__;
+    FItems: array[0..MAX_FRONT_ITEMS-1] of __front_type__;
+    FTop, FBottom: Integer;
+    FCount: Integer;
+    function GetEmpty: Boolean;
+   public
+    constructor Create(const DefaultItem: __front_type__);
+    function First: __front_type__;
+    function Remove: __front_type__;
+    function Insert(const Value: __front_type__): Boolean;
+    procedure Clear;
+    property Count: Integer read FCount;
+    property Empty: Boolean read GetEmpty;
+  end;
+
+

utils/fppkg/lnet/lcontrolstack.pp

@@ -0,0 +1,102 @@
+{ Control stack
+
+  CopyRight (C) 2004-2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+  This license has been modified. See File LICENSE for more inFormation.
+  Should you find these sources withOut a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lControlStack;
+
+{$mode objfpc}
+
+interface
+
+const
+  TL_CSLENGTH = 3;
+
+type
+  TLOnFull = procedure of object;
+  
+  TLControlStack = class
+   private
+    FItems: array of Char;
+    FIndex: Byte;
+    FOnFull: TLOnFull;
+    function GetFull: Boolean;
+    function GetItem(const i: Byte): Char;
+    procedure SetItem(const i: Byte; const Value: Char);
+   public
+    constructor Create;
+    procedure Clear;
+    procedure Push(const Value: Char);
+    property ItemIndex: Byte read FIndex;
+    property Items[i: Byte]: Char read GetItem write SetItem; default;
+    property Full: Boolean read GetFull;
+    property OnFull: TLOnFull read FOnFull write FOnFull;
+  end;
+
+implementation
+
+uses
+  lTelnet;
+  
+constructor TLControlStack.Create;
+begin
+  FOnFull:=nil;
+  FIndex:=0;
+  SetLength(FItems, TL_CSLENGTH);
+end;
+
+function TLControlStack.GetFull: Boolean;
+begin
+  Result:=False;
+  if FIndex >= TL_CSLENGTH then
+    Result:=True;
+end;
+
+function TLControlStack.GetItem(const i: Byte): Char;
+begin
+  Result:=TS_NOP;
+  if i < TL_CSLENGTH then
+    Result:=FItems[i];
+end;
+
+procedure TLControlStack.SetItem(const i: Byte; const Value: Char);
+begin
+  if i < TL_CSLENGTH then
+    FItems[i]:=Value;
+end;
+
+procedure TLControlStack.Clear;
+begin
+  FIndex:=0;
+end;
+
+procedure TLControlStack.Push(const Value: Char);
+begin
+  if FIndex < TL_CSLENGTH then begin
+    FItems[FIndex]:=Value;
+    Inc(FIndex);
+    if Full and Assigned(FOnFull) then
+      FOnFull;
+  end;
+end;
+
+end.
+

utils/fppkg/lnet/levents.pp

@@ -0,0 +1,566 @@
+{ lNet Events abstration
+
+  CopyRight (C) 2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  
+  This license has been modified. See File LICENSE.ADDON for more inFormation.
+  Should you find these sources without a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lEvents;
+
+{$mode objfpc}{$H+}
+{$inline on}
+{$define nochoice}  // let's presume we don't have "optimized" eventer
+
+interface
+
+uses
+  {$ifdef Linux}
+    {$undef nochoice} // undefine for all "Optimized" targets
+    Linux, Contnrs,
+  {$endif}
+  {$ifdef BSD}
+    {$undef nochoice}
+    BSD,
+  {$endif}
+  {$i sys/osunits.inc}
+
+type
+  TLHandle = class;
+  TLEventer = class;
+
+  TLHandleEvent = procedure (aHandle: TLHandle) of object;
+  TLHandleErrorEvent = procedure (aHandle: TLHandle; const msg: string) of object;
+  TLEventerErrorCallback = procedure (const msg: string; Sender: TLEventer) of object;
+  
+  TArrayP = array of Pointer;
+
+  { TLHandle }
+
+  TLHandle = class(TObject)
+   protected
+    FHandle: THandle;
+    FEventer: TLEventer;     // "queue holder"
+    FOnRead: TLHandleEvent;
+    FOnWrite: TLHandleEvent;
+    FOnError: TLHandleErrorEvent;
+    FIgnoreWrite: Boolean;   // so we can do edge-triggered
+    FIgnoreRead: Boolean;    // so we can do edge-triggered
+    FIgnoreError: Boolean;   // so we can do edge-triggered
+    FDispose: Boolean;       // will free in the after-cycle
+    FFreeing: Boolean;       // used to see if it's in the "to be freed" list
+    FPrev: TLHandle;
+    FNext: TLHandle;
+    FFreeNext: TLHandle;
+    FUserData: Pointer;
+    FInternalData: Pointer;
+    procedure SetIgnoreError(const aValue: Boolean);
+    procedure SetIgnoreWrite(const aValue: Boolean);
+    procedure SetIgnoreRead(const aValue: Boolean);
+   public
+    constructor Create; virtual;
+    destructor Destroy; override;
+    procedure Free; virtual;          // this is a trick
+    property Prev: TLHandle read FPrev write FPrev;
+    property Next: TLHandle read FNext write FNext;
+    property FreeNext: TLHandle read FFreeNext write FFreeNext;
+    property IgnoreWrite: Boolean read FIgnoreWrite write SetIgnoreWrite;
+    property IgnoreRead: Boolean read FIgnoreRead write SetIgnoreRead;
+    property IgnoreError: Boolean read FIgnoreError write SetIgnoreError;
+    property OnRead: TLHandleEvent read FOnRead write FOnRead;
+    property OnWrite: TLHandleEvent read FOnWrite write FOnWrite;
+    property OnError: TLHandleErrorEvent read FOnError write FOnError;
+    property UserData: Pointer read FUserData write FUserData;
+    property Dispose: Boolean read FDispose write FDispose;
+    property Handle: THandle read FHandle write FHandle;
+    property Eventer: TLEventer read FEventer;
+  end;
+
+  { TLTimer }
+{
+  TLTimer = class(TObject)
+  protected
+    FOnTimer: TNotifyEvent;
+    FInterval: TDateTime;
+    FTimeout: TDateTime;
+    FPeriodic: Boolean;
+    FEnabled: Boolean;
+    FNext: TLTimer;
+
+    function  GetInterval: Integer;
+    procedure SetEnabled(NewEnabled: Boolean);
+    procedure SetInterval(NewInterval: Integer);
+  public
+    procedure CallAction;
+    property Enabled: Boolean read FEnabled write SetEnabled;
+    property Interval: Integer read GetInterval write SetInterval;
+    property Periodic: Boolean read FPeriodic write FPeriodic;
+    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
+  end;
+}
+  { TLTimeoutManager }
+{
+  TLSetTimeout = procedure(NewTimeout: DWord) of object;
+
+  TLTimeoutManager = class
+  protected
+    FFirst: TLTimer;
+    FLast: TLTimer;
+    FTimeout: DWord;
+    FSetTimeout: TLSetTimeout;
+  public
+    destructor Destroy; override;
+
+    procedure AddTimer(ATimer: TLTimer);
+    procedure RemoveTimer(ATimer: TLTimer);
+
+    procedure CallAction;
+  end;
+}
+  { TLEventer }
+
+  TLEventer = class
+   protected
+    FRoot: TLHandle;
+    FCount: Integer;
+    FOnError: TLEventerErrorCallback;
+    FReferences: Integer;
+    FFreeRoot: TLHandle; // the root of "free" list if any
+    FFreeIter: TLHandle; // the last of "free" list if any
+    FInLoop: Boolean;
+    function GetTimeout: DWord; virtual;
+    procedure SetTimeout(const Value: DWord); virtual;
+    function Bail(const msg: string; const Ernum: Integer): Boolean;
+    procedure AddForFree(aHandle: TLHandle);
+    procedure FreeHandles;
+    procedure HandleIgnoreError(aHandle: TLHandle); virtual;
+    procedure HandleIgnoreWrite(aHandle: TLHandle); virtual;
+    procedure HandleIgnoreRead(aHandle: TLHandle); virtual;
+    function GetInternalData(aHandle: TLHandle): Pointer;
+    procedure SetInternalData(aHandle: TLHandle; const aData: Pointer);
+    procedure SetHandleEventer(aHandle: TLHandle);
+   public
+    constructor Create; virtual;
+    destructor Destroy; override;
+    function AddHandle(aHandle: TLHandle): Boolean; virtual;
+    function CallAction: Boolean; virtual;
+    procedure RemoveHandle(aHandle: TLHandle); virtual;
+    procedure UnplugHandle(aHandle: TLHandle); virtual;
+    procedure LoadFromEventer(aEventer: TLEventer); virtual;
+    procedure Clear;
+    procedure AddRef;
+    procedure DeleteRef;
+    property Timeout: DWord read GetTimeout write SetTimeout;
+    property OnError: TLEventerErrorCallback read FOnError write FOnError;
+    property Count: Integer read FCount;
+  end;
+  TLEventerClass = class of TLEventer;
+  
+  { TLSelectEventer }
+
+  TLSelectEventer = class(TLEventer)
+   protected
+    FTimeout: TTimeVal;
+    FReadFDSet: TFDSet;
+    FWriteFDSet: TFDSet;
+    FErrorFDSet: TFDSet;
+    function GetTimeout: DWord; override;
+    procedure SetTimeout(const Value: DWord); override;
+    procedure ClearSets;
+   public
+    constructor Create; override;
+    function CallAction: Boolean; override;
+  end;
+  
+{$i sys/lkqueueeventerh.inc}
+{$i sys/lepolleventerh.inc}
+
+  function BestEventerClass: TLEventerClass;
+
+implementation
+
+uses
+  lCommon;
+  
+{ TLHandle }
+
+procedure TLHandle.SetIgnoreError(const aValue: Boolean);
+begin
+  if FIgnoreError <> aValue then begin
+    FIgnoreError:=aValue;
+    if Assigned(FEventer) then
+      FEventer.HandleIgnoreError(Self);
+  end;
+end;
+
+procedure TLHandle.SetIgnoreWrite(const aValue: Boolean);
+begin
+  if FIgnoreWrite <> aValue then begin
+    FIgnoreWrite:=aValue;
+    if Assigned(FEventer) then
+      FEventer.HandleIgnoreWrite(Self);
+  end;
+end;
+
+procedure TLHandle.SetIgnoreRead(const aValue: Boolean);
+begin
+  if FIgnoreRead <> aValue then begin
+    FIgnoreRead:=aValue;
+    if Assigned(FEventer) then
+      FEventer.HandleIgnoreRead(Self);
+  end;
+end;
+
+constructor TLHandle.Create;
+begin
+  FOnRead:=nil;
+  FOnWrite:=nil;
+  FOnError:=nil;
+  FUserData:=nil;
+  FEventer:=nil;
+  FPrev:=nil;
+  FNext:=nil;
+  FFreeNext:=nil;
+  FFreeing:=False;
+  FDispose:=False;
+  FIgnoreWrite:=False;
+  FIgnoreRead:=False;
+  FIgnoreError:=False;
+end;
+
+destructor TLHandle.Destroy;
+begin
+  if Assigned(FEventer) then
+    FEventer.UnplugHandle(Self);
+end;
+
+procedure TLHandle.Free;
+begin
+  if Assigned(FEventer) and FEventer.FInLoop then
+    FEventer.AddForFree(Self)
+  else
+    inherited Free;
+end;
+
+{ TLTimer }
+{
+function TLTimer.GetInterval: Integer;
+begin
+  Result := Round(FInterval * MSecsPerDay);
+end;
+
+procedure TLTimer.SetEnabled(NewEnabled: integer);
+begin
+  FTimeout := Now + Interval;
+  FEnabled := true;
+end;
+
+procedure TLTimer.SetInterval(const aValue: Integer);
+begin
+  FInterval := AValue / MSecsPerDay;
+end;
+
+procedure TLTimer.CallAction;
+begin
+  if FEnabled and Assigned(FOnTimer) and (Now - FStarted >= FInterval) then 
+  begin
+    FOnTimer(Self);
+    if not FOneShot then
+      FStarted := Now
+    else
+      FEnabled := false;
+  end;
+end;
+}
+{ TLEventer }
+
+constructor TLEventer.Create;
+begin
+  FRoot:=nil;
+  FFreeRoot:=nil;
+  FFreeIter:=nil;
+  FInLoop:=False;
+  FCount:=0;
+  FReferences:=1;
+end;
+
+destructor TLEventer.Destroy;
+begin
+  Clear;
+end;
+
+function TLEventer.GetTimeout: DWord;
+begin
+  Result:=0;
+end;
+
+procedure TLEventer.SetTimeout(const Value: DWord);
+begin
+end;
+
+function TLEventer.Bail(const msg: string; const Ernum: Integer): Boolean;
+begin
+  Result := False; // always false, substitute for caller's result
+  if Assigned(FOnError) then
+    FOnError(msg + ': ' + LStrError(Ernum), Self);
+end;
+
+procedure TLEventer.AddForFree(aHandle: TLHandle);
+begin
+  if not aHandle.FFreeing then begin
+    aHandle.FFreeing:=True;
+    if not Assigned(FFreeIter) then begin
+      FFreeIter:=aHandle;
+      FFreeRoot:=aHandle;
+    end else begin
+      FFreeIter.FreeNext:=aHandle;
+      FFreeIter:=aHandle;
+    end;
+  end;
+end;
+
+procedure TLEventer.FreeHandles;
+var
+  Temp, Temp2: TLHandle;
+begin
+  Temp:=FFreeRoot;
+  while Assigned(Temp) do begin
+    Temp2:=Temp.FreeNext;
+    Temp.Free;
+    Temp:=Temp2;
+  end;
+  FFreeRoot:=nil;
+  FFreeIter:=nil;
+end;
+
+procedure TLEventer.HandleIgnoreError(aHandle: TLHandle);
+begin
+
+end;
+
+procedure TLEventer.HandleIgnoreWrite(aHandle: TLHandle);
+begin
+
+end;
+
+procedure TLEventer.HandleIgnoreRead(aHandle: TLHandle);
+begin
+
+end;
+
+function TLEventer.GetInternalData(aHandle: TLHandle): Pointer;
+begin
+  Result:=aHandle.FInternalData;
+end;
+
+procedure TLEventer.SetInternalData(aHandle: TLHandle; const aData: Pointer);
+begin
+  aHandle.FInternalData:=aData;
+end;
+
+procedure TLEventer.SetHandleEventer(aHandle: TLHandle);
+begin
+  aHandle.FEventer:=Self;
+end;
+
+function TLEventer.AddHandle(aHandle: TLHandle): Boolean;
+begin
+  Result:=False;
+  if not Assigned(aHandle.FEventer) then begin
+    if not Assigned(FRoot) then begin
+      FRoot:=aHandle;
+    end else begin
+      if Assigned(FRoot.FNext) then begin
+        FRoot.FNext.FPrev:=aHandle;
+        aHandle.FNext:=FRoot.FNext;
+      end;
+      FRoot.FNext:=aHandle;
+      aHandle.FPrev:=FRoot;
+    end;
+    aHandle.FEventer:=Self;
+    Inc(FCount);
+    Result:=True;
+  end;
+end;
+
+function TLEventer.CallAction: Boolean;
+begin
+  Result:=True;
+  // override in ancestor
+end;
+
+procedure TLEventer.RemoveHandle(aHandle: TLHandle);
+begin
+  aHandle.Free;
+end;
+
+procedure TLEventer.UnplugHandle(aHandle: TLHandle);
+begin
+  if aHandle.FEventer = Self then begin
+    aHandle.FEventer:=nil; // avoid recursive AV
+    if Assigned(aHandle.FPrev) then begin
+      aHandle.FPrev.FNext:=aHandle.FNext;
+      if Assigned(aHandle.FNext) then
+        aHandle.FNext.FPrev:=aHandle.FPrev;
+    end else if Assigned(aHandle.FNext) then begin
+      aHandle.FNext.FPrev:=aHandle.FPrev;
+      if aHandle = FRoot then
+        FRoot:=aHandle.FNext;
+    end else FRoot:=nil;
+    if FCount > 0 then
+      Dec(FCount);
+  end;
+end;
+
+procedure TLEventer.LoadFromEventer(aEventer: TLEventer);
+begin
+  Clear;
+  FRoot:=aEventer.FRoot;
+  FOnError:=aEventer.FOnError;
+end;
+
+procedure TLEventer.Clear;
+var
+  Temp1, Temp2: TLHandle;
+begin
+  Temp1:=FRoot;
+  Temp2:=FRoot;
+  while Assigned(Temp2) do begin
+    Temp1:=Temp2;
+    Temp2:=Temp1.FNext;
+    Temp1.Free;
+  end;
+  FRoot:=nil;
+end;
+
+procedure TLEventer.AddRef;
+begin
+  Inc(FReferences);
+end;
+
+procedure TLEventer.DeleteRef;
+begin
+  if FReferences > 0 then
+    Dec(FReferences);
+  if FReferences = 0 then
+    Free;
+end;
+
+{ TLSelectEventer }
+
+constructor TLSelectEventer.Create;
+begin
+  inherited Create;
+  FTimeout.tv_sec:=0;
+  FTimeout.tv_usec:=0;
+end;
+
+function TLSelectEventer.GetTimeout: DWord;
+begin
+  Result:=(FTimeout.tv_sec * 1000) + FTimeout.tv_usec;
+end;
+
+procedure TLSelectEventer.SetTimeout(const Value: DWord);
+begin
+  FTimeout.tv_sec:=Value div 1000;
+  FTimeout.tv_usec:=Value mod 1000;
+end;
+
+procedure TLSelectEventer.ClearSets;
+begin
+  fpFD_ZERO(FReadFDSet);
+  fpFD_ZERO(FWriteFDSet);
+  fpFD_ZERO(FErrorFDSet);
+end;
+
+function TLSelectEventer.CallAction: Boolean;
+var
+  Temp, Temp2: TLHandle;
+  MaxHandle, n: Integer;
+  TempTime: TTimeVal;
+begin
+  if Assigned(FRoot) then begin
+    FInLoop:=True;
+    Temp:=FRoot;
+    MaxHandle:=0;
+    ClearSets;
+    while Assigned(Temp) do begin
+      if  (not Temp.FDispose       )  // handle still valid
+      and (   (not Temp.IgnoreWrite)  // check write or
+           or (not Temp.IgnoreRead )  // check read or
+           or (not Temp.IgnoreError)) // check for errors
+      then begin
+        if not Temp.IgnoreWrite then
+          fpFD_SET(Temp.FHandle, FWriteFDSet);
+        if not Temp.IgnoreRead then
+          fpFD_SET(Temp.FHandle, FReadFDSet);
+        if not Temp.IgnoreError then
+          fpFD_SET(Temp.FHandle, FErrorFDSet);
+        if Temp.FHandle > MaxHandle then
+          MaxHandle:=Temp.FHandle;
+      end;
+      Temp2:=Temp;
+      Temp:=Temp.FNext;
+      if Temp2.FDispose then
+        Temp2.Free;
+    end;
+
+    TempTime:=FTimeout;
+    n:=fpSelect(MaxHandle + 1, @FReadFDSet, @FWriteFDSet, @FErrorFDSet, @TempTime);
+    
+    if n < 0 then
+      Bail('Error on select', LSocketError);
+    Result:=n > 0;
+    
+    if Result then begin
+      Temp:=FRoot;
+      while Assigned(Temp) do begin
+        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FWriteFDSet) <> 0) then
+          if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
+            Temp.FOnWrite(Temp);
+        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FReadFDSet) <> 0) then
+          if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then
+            Temp.FOnRead(Temp);
+        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FErrorFDSet) <> 0) then
+          if Assigned(Temp.FOnError) and not Temp.IgnoreError then
+            Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError));
+        Temp2:=Temp;
+        Temp:=Temp.FNext;
+        if Temp2.FDispose then
+          AddForFree(Temp2);
+      end;
+    end;
+    FInLoop:=False;
+    if Assigned(FFreeRoot) then
+      FreeHandles;
+  end;
+end;
+
+{$i sys/lkqueueeventer.inc}
+{$i sys/lepolleventer.inc}
+
+{$ifdef nochoice}
+
+function BestEventerClass: TLEventerClass;
+begin
+  Result:=TLSelectEventer;
+end;
+
+{$endif}
+
+end.

utils/fppkg/lnet/lftp.pp

@@ -0,0 +1,1065 @@
+{ lFTP CopyRight (C) 2005-2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+  This license has been modified. See File LICENSE for more inFormation.
+  Should you find these sources withOut a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lFTP;
+
+{$mode objfpc}{$H+}
+{$inline on}
+{$macro on}
+//{$define debug}
+
+interface
+
+uses
+  Classes, lNet, lTelnet;
+  
+type
+  TLFTP = class;
+  TLFTPClient = class;
+
+  TLFTPStatus = (fsNone, fsCon, fsAuth, fsPasv, fsPort, fsList, fsRetr, fsStor,
+                 fsType, fsCWD, fsMKD, fsRMD, fsDEL, fsRNFR, fsRNTO, fsSYS,
+                 fsFeat, fsPWD, fsHelp, fsLast);
+                 
+  TLFTPStatusSet = set of TLFTPStatus;
+                 
+  TLFTPStatusRec = record
+    Status: TLFTPStatus;
+    Args: array[1..2] of string;
+  end;
+  
+  TLFTPTransferMethod = (ftActive, ftPassive);
+                 
+  TLFTPClientStatusEvent = procedure (aSocket: TLSocket;
+                                     const aStatus: TLFTPStatus) of object;
+
+  { TLFTPStatusStack }
+
+  { TLFTPStatusFront }
+  {$DEFINE __front_type__  :=  TLFTPStatusRec}
+  {$i lcontainersh.inc}
+  TLFTPStatusFront = TLFront;
+  
+  TLFTP = class(TLComponent, ILDirect)
+   protected
+    FControl: TLTelnetClient;
+    FData: TLTcp;//TLTcpList;
+    FSending: Boolean;
+    FTransferMethod: TLFTPTransferMethod;
+
+    function GetConnected: Boolean; virtual;
+    
+    function GetTimeout: DWord;
+    procedure SetTimeout(const Value: DWord);
+    
+    function GetSocketClass: TLSocketClass;
+    procedure SetSocketClass(Value: TLSocketClass);
+   public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+    
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+   public
+    property Connected: Boolean read GetConnected;
+    property Timeout: DWord read GetTimeout write SetTimeout;
+    property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
+    property ControlConnection: TLTelnetClient read FControl;
+    property DataConnection: TLTCP read FData;
+    property TransferMethod: TLFTPTransferMethod read FTransferMethod write FTransferMethod;
+  end;
+
+  { TLFTPTelnetClient }
+  
+  TLFTPTelnetClient = class(TLTelnetClient)
+   protected
+    procedure React(const Operation, Command: Char); override;
+  end;
+
+  { TLFTPClient }
+
+  TLFTPClient = class(TLFTP, ILClient)
+   protected
+    FStatus: TLFTPStatusFront;
+    FCommandFront: TLFTPStatusFront;
+    FStoreFile: TFileStream;
+    FExpectedBinary: Boolean;
+    FPipeLine: Boolean;
+    FPassword: string;
+    FStatusFlags: array[TLFTPStatus] of Boolean;
+
+    FOnError: TLSocketErrorEvent;
+    FOnReceive: TLSocketEvent;
+    FOnSent: TLSocketProgressEvent;
+    FOnControl: TLSocketEvent;
+    FOnConnect: TLSocketEvent;
+    FOnSuccess: TLFTPClientStatusEvent;
+    FOnFailure: TLFTPClientStatusEvent;
+
+    FChunkSize: Word;
+    FLastPort: Word;
+    FStartPort: Word;
+    FStatusSet: TLFTPStatusSet;
+    FSL: TStringList; // for evaluation, I want to prevent constant create/free
+    procedure OnRe(aSocket: TLSocket);
+    procedure OnDs(aSocket: TLSocket);
+    procedure OnSe(aSocket: TLSocket);
+    procedure OnEr(const msg: string; aSocket: TLSocket);
+
+    procedure OnControlEr(const msg: string; aSocket: TLSocket);
+    procedure OnControlRe(aSocket: TLSocket);
+    procedure OnControlCo(aSocket: TLSocket);
+    
+    function GetTransfer: Boolean;
+
+    function GetEcho: Boolean;
+    procedure SetEcho(const Value: Boolean);
+
+    function GetConnected: Boolean; override;
+
+    function GetBinary: Boolean;
+    procedure SetBinary(const Value: Boolean);
+
+    function CanContinue(const aStatus: TLFTPStatus; const Arg1, Arg2: string): Boolean;
+
+    function CleanInput(var s: string): Integer;
+
+    procedure SetStartPor(const Value: Word);
+
+    procedure EvaluateAnswer(const Ans: string);
+
+    procedure PasvPort;
+
+    procedure SendChunk(const Event: Boolean);
+
+    procedure ExecuteFrontCommand;
+   public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
+    
+    function Connect(const aHost: string; const aPort: Word = 21): Boolean; virtual;
+    function Connect: Boolean; virtual;
+    
+    function Authenticate(const aUsername, aPassword: string): Boolean;
+    
+    function GetData(var aData; const aSize: Integer): Integer;
+    function GetDataMessage: string;
+    
+    function Retrieve(const FileName: string): Boolean;
+    function Put(const FileName: string): Boolean; virtual; // because of LCLsocket
+    
+    function ChangeDirectory(const DestPath: string): Boolean;
+    function MakeDirectory(const DirName: string): Boolean;
+    function RemoveDirectory(const DirName: string): Boolean;
+    
+    function DeleteFile(const FileName: string): Boolean;
+    function Rename(const FromName, ToName: string): Boolean;
+   public
+    procedure List(const FileName: string = '');
+    procedure Nlst(const FileName: string = '');
+    procedure SystemInfo;
+    procedure FeatureList;
+    procedure PresentWorkingDirectory;
+    procedure Help(const Arg: string);
+    
+    procedure Disconnect; override;
+    
+    procedure CallAction; override;
+   public
+    property StatusSet: TLFTPStatusSet read FStatusSet write FStatusSet;
+    property ChunkSize: Word read FChunkSize write FChunkSize;
+    property Binary: Boolean read GetBinary write SetBinary;
+    property PipeLine: Boolean read FPipeLine write FPipeLine;
+    property Echo: Boolean read GetEcho write SetEcho;
+    property StartPort: Word read FStartPort write FStartPort;
+    property Transfer: Boolean read GetTransfer;
+
+    property OnError: TLSocketErrorEvent read FOnError write FOnError;
+    property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
+    property OnSent: TLSocketProgressEvent read FOnSent write FOnSent;
+    property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
+    property OnControl: TLSocketEvent read FOnControl write FOnControl;
+    property OnSuccess: TLFTPClientStatusEvent read FOnSuccess write FOnSuccess;
+    property OnFailure: TLFTPClientStatusEvent read FOnFailure write FOnFailure;
+  end;
+  
+implementation
+
+uses
+  SysUtils;
+
+const
+  FLE             = #13#10;
+  DEFAULT_PORT    = 1024;
+
+  EMPTY_REC: TLFTPStatusRec = (Status: fsNone; Args: ('', ''));
+
+  FTPStatusStr: array[TLFTPStatus] of string = ('None', 'Connect', 'Authenticate',
+                                                'Passive', 'Active', 'List', 'Retrieve',
+                                                'Store', 'Type', 'CWD', 'MKDIR',
+                                                'RMDIR', 'Delete', 'RenameFrom',
+                                                'RenameTo', 'System', 'Features',
+                                                'PWD', 'HELP', 'LAST');
+
+procedure Writedbg(const ar: array of const);
+{$ifdef debug}
+var
+  i: Integer;
+begin
+  if High(ar) >= 0 then
+    for i := 0 to High(ar) do
+      case ar[i].vtype of
+        vtInteger: Write(ar[i].vinteger);
+        vtString: Write(ar[i].vstring^);
+        vtAnsiString: Write(AnsiString(ar[i].vpointer));
+        vtBoolean: Write(ar[i].vboolean);
+        vtChar: Write(ar[i].vchar);
+        vtExtended: Write(Extended(ar[i].vpointer^));
+      end;
+  Writeln;
+end;
+{$else}
+begin
+end;
+{$endif}
+
+function MakeStatusRec(const aStatus: TLFTPStatus; const Arg1, Arg2: string): TLFTPStatusRec;
+begin
+  Result.Status := aStatus;
+  Result.Args[1] := Arg1;
+  Result.Args[2] := Arg2;
+end;
+
+{$i lcontainers.inc}
+
+{ TLFTP }
+
+function TLFTP.GetConnected: Boolean;
+begin
+  Result  :=  FControl.Connected;
+end;
+
+function TLFTP.GetTimeout: DWord;
+begin
+  Result := FControl.Timeout;
+end;
+
+procedure TLFTP.SetTimeout(const Value: DWord);
+begin
+  FControl.Timeout := Value;
+  FData.Timeout := Value;
+end;
+
+function TLFTP.GetSocketClass: TLSocketClass;
+begin
+  Result := FControl.SocketClass;
+end;
+
+procedure TLFTP.SetSocketClass(Value: TLSocketClass);
+begin
+  FControl.SocketClass := Value;
+  FData.SocketClass := Value;
+end;
+
+constructor TLFTP.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+
+  FHost := '';
+  FPort := 21;
+
+  FControl := TLFTPTelnetClient.Create(nil);
+
+  FData := TLTcp.Create(nil);
+
+  FTransferMethod  :=  ftPassive; // let's be modern
+end;
+
+destructor TLFTP.Destroy;
+begin
+  FControl.Free;
+  FData.Free;
+
+  inherited Destroy;
+end;
+
+{ TLFTPTelnetClient }
+
+procedure TLFTPTelnetClient.React(const Operation, Command: Char);
+begin
+  // don't do a FUCK since they broke Telnet in FTP as per-usual
+end;
+
+{ TLFTPClient }
+
+constructor TLFTPClient.Create(aOwner: TComponent);
+const
+  DEFAULT_CHUNK = 8192;
+var
+  s: TLFTPStatus;
+begin
+  inherited Create(aOwner);
+
+  FControl.OnReceive := @OnControlRe;
+  FControl.OnConnect := @OnControlCo;
+  FControl.OnError := @OnControlEr;
+
+  FData.OnReceive := @OnRe;
+  FData.OnDisconnect := @OnDs;
+  FData.OnCanSend := @OnSe;
+  FData.OnError := @OnEr;
+
+  FStatusSet := []; // empty Event set
+  FPassWord := '';
+  FChunkSize := DEFAULT_CHUNK;
+  FStartPort := DEFAULT_PORT;
+  FSL := TStringList.Create;
+  FLastPort := FStartPort;
+
+  for s := fsNone to fsDEL do
+    FStatusFlags[s] := False;
+    
+  FStatus := TLFTPStatusFront.Create(EMPTY_REC);
+  FCommandFront := TLFTPStatusFront.Create(EMPTY_REC);
+  
+  FStoreFile := nil;
+end;
+
+destructor TLFTPClient.Destroy;
+begin
+  Disconnect;
+  FSL.Free;
+  FStatus.Free;
+  FCommandFront.Free;
+  if Assigned(FStoreFile) then
+    FreeAndNil(FStoreFile);
+  inherited Destroy;
+end;
+
+procedure TLFTPClient.OnRe(aSocket: TLSocket);
+begin
+  if Assigned(FOnReceive) then
+    FOnReceive(aSocket);
+end;
+
+procedure TLFTPClient.OnDs(aSocket: TLSocket);
+begin
+  // TODO: figure it out brainiac
+  FSending := False;
+  Writedbg(['Disconnected']);
+end;
+
+procedure TLFTPClient.OnSe(aSocket: TLSocket);
+begin
+  if Connected and FSending then
+    SendChunk(True);
+end;
+
+procedure TLFTPClient.OnEr(const msg: string; aSocket: TLSocket);
+begin
+  FSending := False;
+  if Assigned(FOnError) then
+    FOnError(msg, aSocket);
+end;
+
+procedure TLFTPClient.OnControlEr(const msg: string; aSocket: TLSocket);
+begin
+  FSending := False;
+  if Assigned(FOnError) then
+    FOnError(msg, aSocket);
+end;
+
+procedure TLFTPClient.OnControlRe(aSocket: TLSocket);
+begin
+  if Assigned(FOnControl) then
+    FOnControl(aSocket);
+end;
+
+procedure TLFTPClient.OnControlCo(aSocket: TLSocket);
+begin
+  if Assigned(FOnConnect) then
+    FOnConnect(aSocket);
+end;
+
+function TLFTPClient.GetTransfer: Boolean;
+begin
+  Result := FData.Connected;
+end;
+
+function TLFTPClient.GetEcho: Boolean;
+begin
+  Result := FControl.OptionIsSet(TS_ECHO);
+end;
+
+function TLFTPClient.GetConnected: Boolean;
+begin
+  Result  :=  FStatusFlags[fsCon] and inherited;
+end;
+
+function TLFTPClient.GetBinary: Boolean;
+begin
+  Result := FStatusFlags[fsType];
+end;
+
+function TLFTPClient.CanContinue(const aStatus: TLFTPStatus; const Arg1,
+  Arg2: string): Boolean;
+begin
+  Result := FPipeLine or FStatus.Empty;
+  if not Result then
+    FCommandFront.Insert(MakeStatusRec(aStatus, Arg1, Arg2));
+end;
+
+function TLFTPClient.CleanInput(var s: string): Integer;
+var
+  i: Integer;
+begin
+  FSL.Text := s;
+  if FSL.Count > 0 then
+    for i := 0 to FSL.Count-1 do
+      if Length(FSL[i]) > 0 then EvaluateAnswer(FSL[i]);
+  s := StringReplace(s, FLE, LineEnding, [rfReplaceAll]);
+  i := Pos('PASS', s);
+  if i > 0 then
+    s := Copy(s, 1, i-1) + 'PASS';
+  Result := Length(s);
+end;
+
+procedure TLFTPClient.SetStartPor(const Value: Word);
+begin
+  FStartPort := Value;
+  if Value > FLastPort then
+    FLastPort := Value;
+end;
+
+procedure TLFTPClient.SetEcho(const Value: Boolean);
+begin
+  if Value then
+    FControl.SetOption(TS_ECHO)
+  else
+    FControl.UnSetOption(TS_ECHO);
+end;
+
+procedure TLFTPClient.SetBinary(const Value: Boolean);
+const
+  TypeBool: array[Boolean] of string = ('A', 'I');
+begin
+  if CanContinue(fsType, BoolToStr(Value), '') then begin
+    FExpectedBinary := Value;
+    FControl.SendMessage('TYPE ' + TypeBool[Value] + FLE);
+    FStatus.Insert(MakeStatusRec(fsType, '', ''));
+  end;
+end;
+
+procedure TLFTPClient.EvaluateAnswer(const Ans: string);
+
+  function GetNum: Integer;
+  begin
+    try
+      Result := StrToInt(Copy(Ans, 1, 3));
+    except
+      Result := -1;
+    end;
+  end;
+
+  procedure ParsePortIP(s: string);
+  var
+    i, l: Integer;
+    aIP: string;
+    aPort: Word;
+    sl: TStringList;
+  begin
+    if Length(s) >= 15 then begin
+      sl := TStringList.Create;
+      for i := Length(s) downto 5 do
+        if s[i] = ',' then Break;
+      while (i <= Length(s)) and (s[i] in ['0'..'9', ',']) do Inc(i);
+      if not (s[i] in ['0'..'9', ',']) then Dec(i);
+      l := 0;
+      while s[i] in ['0'..'9', ','] do begin
+        Inc(l);
+        Dec(i);
+      end;
+      Inc(i);
+      s := Copy(s, i, l);
+      sl.CommaText := s;
+      aIP := sl[0] + '.' + sl[1] + '.' + sl[2] + '.' + sl[3];
+      try
+        aPort := (StrToInt(sl[4]) * 256) + StrToInt(sl[5]);
+      except
+        aPort := 0;
+      end;
+      Writedbg(['Server PASV addr/port - ', aIP, ' : ', aPort]);
+      if (aPort > 0) and FData.Connect(aIP, aPort) then
+        Writedbg(['Connected after PASV']);
+      sl.Free;
+      FStatus.Remove;
+    end;
+  end;
+  
+  procedure SendFile;
+  begin
+    FStoreFile.Position := 0;
+    FSending := True;
+    SendChunk(False);
+  end;
+  
+  function ValidResponse(const Answer: string): Boolean; inline;
+  begin
+    Result := (Length(Ans) >= 3) and
+            (Ans[1] in ['1'..'5']) and
+            (Ans[2] in ['0'..'9']) and
+            (Ans[3] in ['0'..'9']);
+            
+    if Result then
+      Result := (Length(Ans) = 3) or ((Length(Ans) > 3) and (Ans[4] = ' '));
+  end;
+  
+  procedure Eventize(const aStatus: TLFTPStatus; const Res: Boolean);
+  begin
+    if Res then begin
+      if Assigned(FOnSuccess) and (aStatus in FStatusSet) then
+        FOnSuccess(FData.Iterator, aStatus);
+    end else begin
+      if Assigned(FOnFailure) and (aStatus in FStatusSet) then
+        FOnFailure(FData.Iterator, aStatus);
+    end;
+  end;
+  
+var
+  x: Integer;
+begin
+  x := GetNum;
+  Writedbg(['WOULD EVAL: ', FTPStatusStr[FStatus.First.Status], ' with value: ',
+            x, ' from "', Ans, '"']);
+  if ValidResponse(Ans) then
+    if not FStatus.Empty then begin
+      Writedbg(['EVAL: ', FTPStatusStr[FStatus.First.Status], ' with value: ', x]);
+      case FStatus.First.Status of
+        fsCon  : case x of
+                   220:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+
+        fsAuth : case x of
+                   230:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   331,
+                   332: begin
+                          FStatusFlags[FStatus.First.Status] := False;
+                          FControl.SendMessage('PASS ' + FPassword + FLE);
+                        end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+
+        fsPasv : case x of
+                   227: ParsePortIP(Ans);
+                   300..600: FStatus.Remove;
+                 end;
+
+        fsPort : case x of
+                   200:
+                     begin
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+
+        fsType : case x of
+                   200:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := FExpectedBinary;
+                       Writedbg(['Binary mode: ', FExpectedBinary]);
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+
+        fsRetr : case x of
+                   150: begin { Do nothing } end;
+                   226:
+                     begin
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       FData.Disconnect;
+                       Writedbg(['Disconnecting data connection']);
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove; // error after connection established
+                     end;
+                 end;
+
+        fsStor : case x of
+                   150: SendFile;
+                   
+                   226:
+                     begin
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                 end;
+
+        fsCWD  : case x of
+                   200, 250:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+                 
+        fsList : case x of
+                   150: begin end;
+                   226:
+                     begin
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+                 
+        fsMKD  : case x of
+                   250, 257:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+                 
+        fsRMD,
+        fsDEL  : case x of
+                   250:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+                 
+        fsRNFR : case x of
+                   350:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+                 
+        fsRNTO : case x of
+                   250:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                       FStatus.Remove;
+                     end;
+                   else
+                     begin
+                       Eventize(FStatus.First.Status, False);
+                       FStatus.Remove;
+                     end;
+                 end;
+      end;
+    end;
+  if FStatus.Empty and not FCommandFront.Empty then
+    ExecuteFrontCommand;
+end;
+
+procedure TLFTPClient.PasvPort;
+
+  function StringPair(const aPort: Word): string;
+  begin
+    Result := IntToStr(aPort div 256);
+    Result := Result + ',' + IntToStr(aPort mod 256);
+  end;
+  
+  function StringIP: string;
+  begin
+    Result := StringReplace(FControl.Connection.Iterator.LocalAddress, '.', ',',
+                          [rfReplaceAll]) + ',';
+  end;
+  
+begin
+  if FTransferMethod = ftActive then begin
+    Writedbg(['Sent PORT']);
+    FData.Disconnect;
+    FData.Listen(FLastPort);
+    FControl.SendMessage('PORT ' + StringIP + StringPair(FLastPort) + FLE);
+    FStatus.Insert(MakeStatusRec(fsPort, '', ''));
+
+    if FLastPort < 65535 then
+      Inc(FLastPort)
+    else
+      FLastPort := FStartPort;
+  end else begin
+    Writedbg(['Sent PASV']);
+    FControl.SendMessage('PASV' + FLE);
+    FStatus.Insert(MakeStatusRec(fsPasv, '', ''));
+  end;
+end;
+
+procedure TLFTPClient.SendChunk(const Event: Boolean);
+var
+  Buf: array[0..65535] of Byte;
+  n: Integer;
+  Sent: Integer;
+begin
+  repeat
+    n := FStoreFile.Read(Buf, FChunkSize);
+    if n > 0 then begin
+      Sent := FData.Send(Buf, n);
+      if Event and Assigned(FOnSent) and (Sent > 0) then
+        FOnSent(FData.Iterator, Sent);
+      if Sent < n then
+        FStoreFile.Position := FStoreFile.Position - (n - Sent); // so it's tried next time
+    end else begin
+      if Assigned(FOnSent) then
+        FOnSent(FData.Iterator, 0);
+      FreeAndNil(FStoreFile);
+      FSending := False;
+      {$hint this one calls freeinstance which doesn't pass}
+      FData.Disconnect;
+    end;
+  until (n = 0) or (Sent = 0);
+end;
+
+procedure TLFTPClient.ExecuteFrontCommand;
+begin
+  with FCommandFront.First do
+    case Status of
+      fsNone : Exit;
+      fsAuth : Authenticate(Args[1], Args[2]);
+      fsList : List(Args[1]);
+      fsRetr : Retrieve(Args[1]);
+      fsStor : Put(Args[1]);
+      fsCWD  : ChangeDirectory(Args[1]);
+      fsMKD  : MakeDirectory(Args[1]);
+      fsRMD  : RemoveDirectory(Args[1]);
+      fsDEL  : DeleteFile(Args[1]);
+      fsRNFR : Rename(Args[1], Args[2]);
+      fsSYS  : SystemInfo;
+      fsPWD  : PresentWorkingDirectory;
+      fsHelp : Help(Args[1]);
+      fsType : SetBinary(StrToBool(Args[1]));
+      fsFeat : FeatureList;
+    end;
+  FCommandFront.Remove;
+end;
+
+function TLFTPClient.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+var
+  s: string;
+begin
+  Result := FControl.Get(aData, aSize, aSocket);
+  if Result > 0 then begin
+    SetLength(s, Result);
+    Move(aData, PChar(s)^, Result);
+    CleanInput(s);
+  end;
+end;
+
+function TLFTPClient.GetMessage(out msg: string; aSocket: TLSocket): Integer;
+begin
+  Result := FControl.GetMessage(msg, aSocket);
+  if Result > 0 then
+    Result := CleanInput(msg);
+end;
+
+function TLFTPClient.Send(const aData; const aSize: Integer; aSocket: TLSocket
+  ): Integer;
+begin
+  Result := FControl.Send(aData, aSize);
+end;
+
+function TLFTPClient.SendMessage(const msg: string; aSocket: TLSocket
+  ): Integer;
+begin
+  Result := FControl.SendMessage(msg);
+end;
+
+function TLFTPClient.GetData(var aData; const aSize: Integer): Integer;
+begin
+  Result := FData.Iterator.Get(aData, aSize);
+end;
+
+function TLFTPClient.GetDataMessage: string;
+begin
+  Result := '';
+  if Assigned(FData.Iterator) then
+    FData.Iterator.GetMessage(Result);
+end;
+
+function TLFTPClient.Connect(const aHost: string; const aPort: Word): Boolean;
+begin
+  Result := False;
+  Disconnect;
+  if FControl.Connect(aHost, aPort) then begin
+    FHost := aHost;
+    FPort := aPort;
+    FStatus.Insert(MakeStatusRec(fsCon, '', ''));
+    Result := True;
+  end;
+  if FData.Eventer <> FControl.Connection.Eventer then
+    FData.Eventer := FControl.Connection.Eventer;
+end;
+
+function TLFTPClient.Connect: Boolean;
+begin
+  Result := Connect(FHost, FPort);
+end;
+
+function TLFTPClient.Authenticate(const aUsername, aPassword: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsAuth, aUserName, aPassword) then begin
+    FPassword := aPassword;
+    FControl.SendMessage('USER ' + aUserName + FLE + 'PASS ' + aPassword + FLE);
+    FStatus.Insert(MakeStatusRec(fsAuth, '', ''));
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.Retrieve(const FileName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsRetr, FileName, '') then begin
+    PasvPort;
+    FControl.SendMessage('RETR ' + FileName + FLE);
+    FStatus.Insert(MakeStatusRec(fsRetr, '', ''));
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.Put(const FileName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if FileExists(FileName) and CanContinue(fsStor, FileName, '') then begin
+    FStoreFile := TFileStream.Create(FileName, fmOpenRead);
+    PasvPort;
+    FControl.SendMessage('STOR ' + ExtractFileName(FileName) + FLE);
+    FStatus.Insert(MakeStatusRec(fsStor, '', ''));
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.ChangeDirectory(const DestPath: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsCWD, DestPath, '') then begin
+    FControl.SendMessage('CWD ' + DestPath + FLE);
+    FStatus.Insert(MakeStatusRec(fsCWD, '', ''));
+    FStatusFlags[fsCWD] := False;
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.MakeDirectory(const DirName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsMKD, DirName, '') then begin
+    FControl.SendMessage('MKD ' + DirName + FLE);
+    FStatus.Insert(MakeStatusRec(fsMKD, '', ''));
+    FStatusFlags[fsMKD] := False;
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.RemoveDirectory(const DirName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsRMD, DirName, '') then begin
+    FControl.SendMessage('RMD ' + DirName + FLE);
+    FStatus.Insert(MakeStatusRec(fsRMD, '', ''));
+    FStatusFlags[fsRMD] := False;
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.DeleteFile(const FileName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsDEL, FileName, '') then begin
+    FControl.SendMessage('DELE ' + FileName + FLE);
+    FStatus.Insert(MakeStatusRec(fsDEL, '', ''));
+    FStatusFlags[fsDEL] := False;
+    Result := True;
+  end;
+end;
+
+function TLFTPClient.Rename(const FromName, ToName: string): Boolean;
+begin
+  Result := not FPipeLine;
+  if CanContinue(fsRNFR, FromName, ToName) then begin
+    FControl.SendMessage('RNFR ' + FromName + FLE);
+    FStatus.Insert(MakeStatusRec(fsRNFR, '', ''));
+    FStatusFlags[fsRNFR] := False;
+
+    FControl.SendMessage('RNTO ' + ToName + FLE);
+    FStatus.Insert(MakeStatusRec(fsRNTO, '', ''));
+    FStatusFlags[fsRNTO] := False;
+
+    Result := True;
+  end;
+end;
+
+procedure TLFTPClient.List(const FileName: string = '');
+begin
+  if CanContinue(fsList, FileName, '') then begin
+    PasvPort;
+    FStatus.Insert(MakeStatusRec(fsList, '', ''));
+    if Length(FileName) > 0 then
+      FControl.SendMessage('LIST ' + FileName + FLE)
+    else
+      FControl.SendMessage('LIST' + FLE);
+  end;
+end;
+
+procedure TLFTPClient.Nlst(const FileName: string);
+begin
+  if CanContinue(fsList, FileName, '') then begin
+    PasvPort;
+    FStatus.Insert(MakeStatusRec(fsList, '', ''));
+    if Length(FileName) > 0 then
+      FControl.SendMessage('NLST ' + FileName + FLE)
+    else
+      FControl.SendMessage('NLST' + FLE);
+  end;
+end;
+
+procedure TLFTPClient.SystemInfo;
+begin
+  if CanContinue(fsSYS, '', '') then
+    FControl.SendMessage('SYST' + FLE);
+end;
+
+procedure TLFTPClient.FeatureList;
+begin
+  if CanContinue(fsFeat, '', '') then
+    FControl.SendMessage('FEAT' + FLE);
+end;
+
+procedure TLFTPClient.PresentWorkingDirectory;
+begin
+  if CanContinue(fsPWD, '', '') then
+    FControl.SendMessage('PWD' + FLE);
+end;
+
+procedure TLFTPClient.Help(const Arg: string);
+begin
+  if CanContinue(fsHelp, Arg, '') then
+    FControl.SendMessage('HELP ' + Arg + FLE);
+end;
+
+procedure TLFTPClient.Disconnect;
+var
+  s: TLFTPStatus;
+begin
+  FControl.Disconnect;
+  FStatus.Clear;
+  FData.Disconnect;
+  FLastPort := FStartPort;
+  for s := fsNone to fsLast do
+    FStatusFlags[s] := False;
+  FCommandFront.Clear;
+end;
+
+procedure TLFTPClient.CallAction;
+begin
+  TLFTPTelnetClient(FControl).CallAction;
+end;
+
+initialization
+  Randomize;
+
+end.
+

utils/fppkg/lnet/lnet.pp

@@ -0,0 +1,1266 @@
+{ lNet v0.4.0
+
+  CopyRight (C) 2004-2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  
+  This license has been modified. See File LICENSE.ADDON for more inFormation.
+  Should you find these sources without a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lNet;
+
+{$mode objfpc}{$H+}{$T-}
+{$interfaces corba}
+
+interface
+
+uses
+  Classes, lEvents,
+  {$i sys/osunits.inc}
+
+const
+  { Address constants }
+  LADDR_ANY = '0.0.0.0';
+  LADDR_BR  = '255.255.255.255';
+  LADDR_LO  = '127.0.0.1';
+  { ICMP }
+  LICMP_ECHOREPLY     = 0;
+  LICMP_UNREACH       = 3;
+  LICMP_ECHO          = 8;
+  LICMP_TIME_EXCEEDED = 11;
+  { Protocols }
+  LPROTO_IP     =     0;
+  LPROTO_ICMP   =     1;
+  LPROTO_IGMP   =     2;
+  LPROTO_TCP    =     6;
+  LPROTO_UDP    =    17;
+  LPROTO_IPV6   =    41;
+  LPROTO_ICMPV6 =    58;
+  LPROTO_RAW    =   255;
+  LPROTO_MAX    =   256;
+
+type
+  PLIPHeader = ^TLIPHeader;
+  TLIPHeader = record
+      VerLen      : Byte;
+      TOS         : Byte;
+      TotalLen    : Word;
+      Identifer   : Word;
+      FragOffsets : Word;
+      TTL         : Byte;
+      Protocol    : Byte;
+      CheckSum    : Word;
+      SourceIp    : DWord;
+      DestIp      : DWord;
+      Options     : DWord;
+  end;  // TLIPHeader
+
+
+  TLSocket = class;
+  TLComponent = class;
+  
+  { Callback Event procedure for errors }
+  TLSocketErrorEvent = procedure(const msg: string; aSocket: TLSocket) of object;
+
+  { Callback Event procedure for others }
+  TLSocketEvent = procedure(aSocket: TLSocket) of object;
+
+  { Callback Event procedure for progress reports}
+  TLSocketProgressEvent = procedure (aSocket: TLSocket; const Bytes: Integer) of object;
+
+  { Base socket class, Holds Address and socket info, perForms basic
+    socket operations, uses select always to figure out if it can work (slow) }
+
+  { TLSocket }
+
+  TLSocket = class(TLHandle)
+   protected
+    FAddress: TInetSockAddr;
+    FPeerAddress: TInetSockAddr;
+    FConnected: Boolean;
+    FConnecting: Boolean;
+    FSocketClass: Integer;
+    FProtocol: Integer;
+    FNextSock: TLSocket;
+    FPrevSock: TLSocket;
+    FIgnoreShutdown: Boolean;
+    FCanSend: Boolean;
+    FCanReceive: Boolean;
+    FServerSocket: Boolean;
+    FOnFree: TLSocketEvent;
+    FBlocking: Boolean;
+    FListenBacklog: Integer;
+    FCreator: TLComponent;
+   protected
+    function DoSend(const TheData; const TheSize: Integer): Integer;
+    
+    function SetupSocket(const APort: Word; const Address: string): Boolean; virtual;
+    
+    function GetLocalPort: Word;
+    function GetPeerPort: Word;
+    function GetPeerAddress: string;
+    function GetLocalAddress: string;
+    function CanSend: Boolean; virtual;
+    function CanReceive: Boolean; virtual;
+    
+    procedure SetBlocking(const aValue: Boolean);
+    procedure SetOptions; virtual;
+    
+    function Bail(const msg: string; const ernum: Integer): Boolean;
+    
+    procedure LogError(const msg: string; const ernum: Integer); virtual;
+   public
+    constructor Create; override;
+    destructor Destroy; override;
+    
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
+    function Accept(const SerSock: Integer): Boolean;
+    
+    function Connect(const Address: string; const APort: Word): Boolean;
+    
+    function Send(const aData; const aSize: Integer): Integer; virtual;
+    function SendMessage(const msg: string): Integer;
+    
+    function Get(var aData; const aSize: Integer): Integer; virtual;
+    function GetMessage(out msg: string): Integer;
+    
+    procedure Disconnect; virtual;
+   public
+    property Connected: Boolean read FConnected;
+    property Connecting: Boolean read FConnecting;
+    property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
+    property Protocol: Integer read FProtocol write FProtocol;
+    property SocketType: Integer read FSocketClass write FSocketClass;
+    property Blocking: Boolean read FBlocking write SetBlocking;
+    property PeerAddress: string read GetPeerAddress;
+    property PeerPort: Word read GetPeerPort;
+    property LocalAddress: string read GetLocalAddress;
+    property LocalPort: Word read GetLocalPort;
+    property NextSock: TLSocket read FNextSock write FNextSock;
+    property PrevSock: TLSocket read FPrevSock write FPrevSock;
+    property Creator: TLComponent read FCreator;
+  end;
+  TLSocketClass = class of TLSocket;
+
+  { this is the socket used by TLConnection }
+  
+  TLActionEnum = (acConnect, acAccept, acSend, acReceive, acError);
+
+  { Base interface common to ALL connections }
+  
+  ILComponent = interface
+    procedure Disconnect;
+    procedure CallAction;
+    
+    property SocketClass: TLSocketClass;
+    property Host: string;
+    property Port: Word;
+  end;
+  
+  { Interface for protools with direct send/get capabilities }
+
+  ILDirect = interface
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer;
+
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer;
+  end;
+  
+  { Interface for all servers }
+  
+  ILServer = interface
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
+  end;
+
+  { Interface for all clients }
+  
+  ILClient = interface
+    function Connect(const Address: string; const APort: Word): Boolean; overload;
+    function Connect: Boolean; overload;
+  end;
+  
+  { TLComponent }
+
+  TLComponent = class(TComponent, ILComponent)
+   protected
+    FHost: string;
+    FPort: Word;
+    FSocketClass: TLSocketClass;
+    FCreator: TLComponent;
+   public
+    constructor Create(aOwner: TComponent); override;
+    procedure Disconnect; virtual; abstract;
+    procedure CallAction; virtual; abstract;
+
+    property SocketClass: TLSocketClass read FSocketClass write FSocketClass;
+    property Host: string read FHost write FHost;
+    property Port: Word read FPort write FPort;
+    property Creator: TLComponent read FCreator write FCreator;
+  end;
+  
+  { TLConnection
+    Common ancestor for TLBaseTcp and TLUdp classes. Holds Event properties
+    and common variables. }
+
+  TLConnection = class(TLComponent, ILDirect, ILServer, ILClient)
+   protected
+    FTimeVal: TTimeVal;
+    FOnReceive: TLSocketEvent;
+    FOnAccept: TLSocketEvent;
+    FOnConnect: TLSocketEvent;
+    FOnDisconnect: TLSocketEvent;
+    FOnCanSend: TLSocketEvent;
+    FOnError: TLSocketErrorEvent;
+    FRootSock: TLSocket;
+    FIterator: TLSocket;
+    FID: Integer; // internal number for server
+    FEventer: TLEventer;
+    FEventerClass: TLEventerClass;
+    FTimeout: DWord;
+    FListenBacklog: Integer;
+   protected
+    function InitSocket(aSocket: TLSocket): TLSocket; virtual;
+    
+    function GetConnected: Boolean; virtual; abstract;
+    function GetCount: Integer; virtual;
+    function GetItem(const i: Integer): TLSocket;
+    
+    function GetTimeout: DWord;
+    procedure SetTimeout(const AValue: DWord);
+    
+    procedure SetEventer(Value: TLEventer);
+    
+    procedure ConnectAction(aSocket: TLHandle); virtual;
+    procedure AcceptAction(aSocket: TLHandle); virtual;
+    procedure ReceiveAction(aSocket: TLHandle); virtual;
+    procedure SendAction(aSocket: TLHandle); virtual;
+    procedure ErrorAction(aSocket: TLHandle; const msg: string); virtual;
+    
+    procedure ConnectEvent(aSocket: TLHandle); virtual;
+    procedure DisconnectEvent(aSocket: TLHandle); virtual;
+    procedure AcceptEvent(aSocket: TLHandle); virtual;
+    procedure ReceiveEvent(aSocket: TLHandle); virtual;
+    procedure CanSendEvent(aSocket: TLHandle); virtual;
+    procedure ErrorEvent(const msg: string; aSocket: TLHandle); virtual;
+    procedure EventerError(const msg: string; Sender: TLEventer);
+    
+    procedure RegisterWithEventer; virtual;
+    
+    procedure FreeSocks; virtual;
+   public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+    
+    function Connect(const Address: string; const APort: Word): Boolean; virtual;
+    function Connect: Boolean; virtual;
+    
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; virtual; abstract;
+    
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+    function IterNext: Boolean; virtual; abstract;
+    procedure IterReset; virtual; abstract;
+   public
+    property Host: string read FHost write FHost;
+    property Port: Word read FPort write FPort;
+    property OnError: TLSocketErrorEvent read FOnError write FOnError;
+    property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
+    property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
+    property OnCanSend: TLSocketEvent read FOnCanSend write FOnCanSend;
+    property Socks[index: Integer]: TLSocket read GetItem; default;
+    property Count: Integer read GetCount;
+    property Connected: Boolean read GetConnected;
+    property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
+    property Iterator: TLSocket read FIterator;
+    property Timeout: DWord read GetTimeout write SetTimeout;
+    property SocketClass: TLSocketClass read FSocketClass write FSocketClass;
+    property Eventer: TLEventer read FEventer write SetEventer;
+    property EventerClass: TLEventerClass read FEventerClass write FEventerClass;
+  end;
+  
+  { UDP Client/Server class. Provided to enable usage of UDP sockets }
+
+  { TLUdp }
+
+  TLUdp = class(TLConnection)
+   protected
+    function InitSocket(aSocket: TLSocket): TLSocket; override;
+    
+    function GetConnected: Boolean; override;
+    
+    procedure ReceiveAction(aSocket: TLHandle); override;
+    procedure SendAction(aSocket: TLHandle); override;
+    procedure ErrorAction(aSocket: TLHandle; const msg: string); override;
+    
+    function Bail(const msg: string): Boolean;
+    
+    procedure SetAddress(const Address: string);
+   public
+    constructor Create(aOwner: TComponent); override;
+    
+    function Connect(const Address: string; const APort: Word): Boolean; override;
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; override;
+    
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
+    
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
+    function SendMessage(const msg: string; const Address: string): Integer; overload;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function Send(const aData; const aSize: Integer; const Address: string): Integer; overload;
+    
+    function IterNext: Boolean; override;
+    procedure IterReset; override;
+
+    procedure Disconnect; override;
+
+    procedure CallAction; override;
+  end;
+  
+  { TCP Client/Server class. Provided to enable usage of TCP sockets }
+
+  { TLTcp }
+
+  TLTcp = class(TLConnection)
+   protected
+    FCount: Integer;
+    function InitSocket(aSocket: TLSocket): TLSocket; override;
+
+    function GetConnected: Boolean; override;
+    function GetConnecting: Boolean;
+
+    procedure ConnectAction(aSocket: TLHandle); override;
+    procedure AcceptAction(aSocket: TLHandle); override;
+    procedure ReceiveAction(aSocket: TLHandle); override;
+    procedure SendAction(aSocket: TLHandle); override;
+    procedure ErrorAction(aSocket: TLHandle; const msg: string); override;
+
+    function Bail(const msg: string; aSocket: TLSocket): Boolean;
+
+    procedure SocketDisconnect(aSocket: TLSocket);
+   public
+    constructor Create(aOwner: TComponent); override;
+
+    function Connect(const Address: string; const APort: Word): Boolean; override;
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; override;
+
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
+
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
+
+    function IterNext: Boolean; override;
+    procedure IterReset; override;
+
+    procedure CallAction; override;
+
+    procedure Disconnect; override;
+   public
+    property Connecting: Boolean read GetConnecting;
+    property OnAccept: TLSocketEvent read FOnAccept write FOnAccept;
+    property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
+  end;
+  
+implementation
+
+uses
+  lCommon;
+  
+//********************************TLSocket*************************************
+
+constructor TLSocket.Create;
+begin
+  inherited Create;
+  FHandle := INVALID_SOCKET;
+  FBlocking := False;
+  FListenBacklog := LDEFAULT_BACKLOG;
+  FServerSocket := False;
+  FPrevSock := nil;
+  FNextSock := nil;
+  FCanSend := True;
+  FCanReceive := False;
+  FConnected := False;
+  FConnecting := False;
+  FIgnoreShutdown := False;
+  FSocketClass := SOCK_STREAM;
+  FProtocol := LPROTO_TCP;
+end;
+
+destructor TLSocket.Destroy;
+begin
+  if Assigned(FOnFree) then
+    FOnFree(Self);
+  Disconnect;
+  inherited Destroy;
+end;
+
+procedure TLSocket.Disconnect;
+var
+  WasConnected: Boolean;
+begin
+  WasConnected := FConnected;
+  FDispose := True;
+  FCanSend := True;
+  FCanReceive := True;
+  FIgnoreWrite := True;
+  if FConnected or FConnecting then begin
+    FConnected := False;
+    FConnecting := False;
+    if (FSocketClass = SOCK_STREAM) and (not FIgnoreShutdown) and WasConnected then
+      if ShutDown(FHandle, 2) <> 0 then
+        LogError('Shutdown error', LSocketError);
+    if CloseSocket(FHandle) <> 0 then
+      LogError('Closesocket error', LSocketError);
+    FHandle := INVALID_SOCKET;
+  end;
+end;
+
+procedure TLSocket.LogError(const msg: string; const ernum: Integer);
+begin
+  if Assigned(FOnError) then
+    if ernum > 0 then
+      FOnError(Self, msg + ': ' + LStrError(ernum))
+    else
+      FOnError(Self, msg);
+end;
+
+function TLSocket.Bail(const msg: string; const ernum: Integer): Boolean;
+begin
+  Result  :=  False; // return the result for the caller
+
+  Disconnect;
+  LogError(msg, ernum);
+end;
+
+function TLSocket.GetPeerAddress: string;
+begin
+  Result := '';
+  if FSocketClass = SOCK_STREAM then
+    Result := NetAddrtoStr(FAddress.Addr)
+  else
+    Result := NetAddrtoStr(FPeerAddress.Addr);
+end;
+
+function TLSocket.GetLocalAddress: string;
+var
+  a: TSockAddr;
+  l: Integer;
+begin
+  l := SizeOf(a);
+  GetSocketName(FHandle, a, l);
+  Result := HostAddrToStr(LongWord(a.sin_addr));
+end;
+
+function TLSocket.CanSend: Boolean;
+begin
+  Result := FCanSend and FConnected;
+end;
+
+function TLSocket.CanReceive: Boolean;
+begin
+  Result := FCanReceive and FConnected;
+end;
+
+procedure TLSocket.SetBlocking(const aValue: Boolean);
+begin
+  FBlocking := aValue;
+  if FHandle >= 0 then // we already set our socket
+    if not lCommon.SetBlocking(FHandle, aValue) then
+      Bail('Error on SetBlocking', LSocketError);
+end;
+
+procedure TLSocket.SetOptions;
+begin
+  SetBlocking(FBlocking);
+end;
+
+function TLSocket.GetMessage(out msg: string): Integer;
+begin
+  Result := 0;
+  SetLength(msg, BUFFER_SIZE);
+  SetLength(msg, Get(PChar(msg)^, Length(msg)));
+  Result := Length(msg);
+end;
+
+function TLSocket.Get(var aData; const aSize: Integer): Integer;
+var
+  AddressLength: Integer = SizeOf(FAddress);
+begin
+  Result := 0;
+  if CanReceive then begin
+    if FSocketClass = SOCK_STREAM then
+      Result := sockets.Recv(FHandle, aData, aSize, LMSG)
+    else
+      Result := sockets.Recvfrom(FHandle, aData, aSize, LMSG, FPeerAddress, AddressLength);
+    if Result = 0 then
+      Disconnect;
+    if Result = SOCKET_ERROR then begin
+      if IsBlockError(LSocketError) then begin
+        FCanReceive  :=  False;
+        IgnoreRead  :=  False;
+      end else Bail('Receive Error', LSocketError);
+      Result := 0;
+    end;
+  end;
+end;
+
+function TLSocket.DoSend(const TheData; const TheSize: Integer): Integer;
+begin
+  if FSocketClass = SOCK_STREAM then
+    Result := sockets.send(FHandle, TheData, TheSize, LMSG)
+  else
+    Result := sockets.sendto(FHandle, TheData, TheSize, LMSG, FPeerAddress, SizeOf(FPeerAddress));
+end;
+
+function TLSocket.SetupSocket(const APort: Word; const Address: string): Boolean;
+var
+  Done: Boolean;
+  Arg: Integer;
+begin
+  Result := false;
+  if not FConnected and not FConnecting then begin
+    Done := true;
+    FHandle := fpSocket(AF_INET, FSocketClass, FProtocol);
+    if FHandle = INVALID_SOCKET then
+      Bail('Socket error', LSocketError);
+    SetOptions;
+    if FSocketClass = SOCK_DGRAM then begin
+      Arg := 1;
+      if SetSocketOptions(FHandle, SOL_SOCKET, SO_BROADCAST, Arg, Sizeof(Arg)) = SOCKET_ERROR then
+        Bail('SetSockOpt error', LSocketError);
+    end;
+    
+    FillAddressInfo(FAddress, AF_INET, Address, aPort);
+
+    FillAddressInfo(FPeerAddress, AF_INET, LADDR_BR, aPort);
+
+    Result  :=  Done;
+  end;
+end;
+
+function TLSocket.GetLocalPort: Word;
+begin
+  Result := FAddress.sin_port;
+end;
+
+function TLSocket.GetPeerPort: Word;
+begin
+  Result := FPeerAddress.sin_port;
+end;
+
+function TLSocket.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
+begin
+  if not Connected then begin
+    Result := false;
+    SetupSocket(APort, AIntf);
+    if fpBind(FHandle, psockaddr(@FAddress), SizeOf(FAddress)) = SOCKET_ERROR then
+      Bail('Error on bind', LSocketError)
+    else
+      Result := true;
+    if (FSocketClass = SOCK_STREAM) and Result then
+      if fpListen(FHandle, FListenBacklog) = SOCKET_ERROR then
+        Result  :=  Bail('Error on Listen', LSocketError)
+      else
+        Result := true;
+  end;
+end;
+
+function TLSocket.Accept(const sersock: Integer): Boolean;
+var
+  AddressLength: tsocklen = SizeOf(FAddress);
+begin
+  Result := false;
+  if not Connected then begin
+    FHandle := fpAccept(sersock, psockaddr(@FAddress), @AddressLength);
+    if FHandle <> INVALID_SOCKET then begin
+      SetOptions;
+      Result := true;
+      FConnected := true;
+    end else
+      Bail('Error on accept', LSocketError);
+  end;
+end;
+
+function TLSocket.Connect(const Address: string; const aPort: Word): Boolean;
+begin
+  Result := False;
+  if Connected or FConnecting then
+    Disconnect;
+  if SetupSocket(APort, Address) then begin
+    fpConnect(FHandle, psockaddr(@FAddress), SizeOf(FAddress));
+    FConnecting := True;
+    Result := FConnecting;
+  end;
+end;
+
+function TLSocket.SendMessage(const msg: string): Integer;
+begin
+  Result := Send(PChar(msg)^, Length(msg));
+end;
+
+function TLSocket.Send(const aData; const aSize: Integer): Integer;
+begin
+  Result := 0;
+  if not FServerSocket then begin
+    if aSize <= 0 then
+      Bail('Send error: wrong size (Size <= 0)', -1);
+
+    if CanSend then begin
+      Result := DoSend(aData, aSize);
+      if Result = SOCKET_ERROR then begin
+        if IsBlockError(LSocketError) then begin
+          FCanSend := False;
+          IgnoreWrite := False;
+        end else
+          Bail('Send error', LSocketError);
+        Result := 0;
+      end;
+    end;
+ end;
+end;
+
+//*******************************TLConnection*********************************
+
+constructor TLConnection.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FHost := '';
+  FPort := 0;
+  FListenBacklog := LDEFAULT_BACKLOG;
+  FTimeout := 0;
+  FSocketClass := TLSocket;
+  FOnReceive := nil;
+  FOnError := nil;
+  FOnDisconnect := nil;
+  FOnCanSend := nil;
+  FOnConnect := nil;
+  FOnAccept := nil;
+  FTimeVal.tv_sec := 0;
+  FTimeVal.tv_usec := 0;
+  FIterator := nil;
+  FEventer := nil;
+  FEventerClass := BestEventerClass;
+end;
+
+destructor TLConnection.Destroy;
+begin
+  FreeSocks;
+  if Assigned(FEventer) then
+    FEventer.DeleteRef;
+  inherited Destroy;
+end;
+
+function TLConnection.Connect(const Address: string; const APort: Word
+  ): Boolean;
+begin
+  FHost := Address;
+  FPort := aPort;
+  Result := False;
+end;
+
+function TLConnection.Connect: Boolean;
+begin
+  Result := Connect(FHost, FPort);
+end;
+
+function TLConnection.InitSocket(aSocket: TLSocket): TLSocket;
+begin
+  aSocket.OnRead := @ReceiveAction;
+  aSocket.OnWrite := @SendAction;
+  aSocket.OnError := @ErrorAction;
+  aSocket.ListenBacklog := FListenBacklog;
+  aSocket.FCreator := FCreator;
+  Result := aSocket;
+end;
+
+function TLConnection.GetCount: Integer;
+begin
+  Result := 1;
+end;
+
+function TLConnection.GetItem(const i: Integer): TLSocket;
+var
+  Tmp: TLSocket;
+  Jumps: Integer;
+begin
+  Result := nil;
+  Tmp := FRootSock;
+  Jumps := 0;
+  while Assigned(Tmp.NextSock) and (Jumps < i) do begin
+    Tmp := Tmp.NextSock;
+    Inc(Jumps);
+  end;
+  if Jumps = i then
+    Result := Tmp;
+end;
+
+function TLConnection.GetTimeout: DWord;
+begin
+  if Assigned(FEventer) then
+    Result := FEventer.Timeout
+  else
+    Result := FTimeout;
+end;
+
+procedure TLConnection.ConnectAction(aSocket: TLHandle);
+begin
+end;
+
+procedure TLConnection.AcceptAction(aSocket: TLHandle);
+begin
+end;
+
+procedure TLConnection.ReceiveAction(aSocket: TLHandle);
+begin
+end;
+
+procedure TLConnection.SendAction(aSocket: TLHandle);
+begin
+end;
+
+procedure TLConnection.ErrorAction(aSocket: TLHandle; const msg: string);
+begin
+end;
+
+procedure TLConnection.ConnectEvent(aSocket: TLHandle);
+begin
+  if Assigned(FOnConnect) then
+    FOnConnect(TLSocket(aSocket));
+end;
+
+procedure TLConnection.DisconnectEvent(aSocket: TLHandle);
+begin
+  if Assigned(FOnDisconnect) then
+    FOnDisconnect(TLSocket(aSocket));
+end;
+
+procedure TLConnection.AcceptEvent(aSocket: TLHandle);
+begin
+  if Assigned(FOnAccept) then
+    FOnAccept(TLSocket(aSocket));
+end;
+
+procedure TLConnection.ReceiveEvent(aSocket: TLHandle);
+begin
+  if Assigned(FOnReceive) then
+    FOnReceive(TLSocket(aSocket));
+end;
+
+procedure TLConnection.CanSendEvent(aSocket: TLHandle);
+begin
+  if Assigned(FOnCanSend) then
+    FOnCanSend(TLSocket(aSocket));
+end;
+
+procedure TLConnection.ErrorEvent(const msg: string; aSocket: TLHandle);
+begin
+  if Assigned(FOnError) then
+    FOnError(msg, TLSocket(aSocket));
+end;
+
+procedure TLConnection.SetTimeout(const AValue: DWord);
+begin
+  if Assigned(FEventer) then
+    FEventer.Timeout := aValue;
+  FTimeout := aValue;
+end;
+
+procedure TLConnection.SetEventer(Value: TLEventer);
+begin
+  if Assigned(FEventer) then
+    FEventer.DeleteRef;
+  FEventer := Value;
+  FEventer.AddRef;
+end;
+
+procedure TLConnection.EventerError(const msg: string; Sender: TLEventer);
+begin
+  ErrorEvent(msg, nil);
+end;
+
+procedure TLConnection.RegisterWithEventer;
+begin
+  if not Assigned(FEventer) then begin
+    FEventer := FEventerClass.Create;
+    FEventer.OnError := @EventerError;
+  end;
+
+  if Assigned(FRootSock) then
+    FEventer.AddHandle(FRootSock);
+
+  if (FEventer.Timeout = 0) and (FTimeout > 0) then
+    FEventer.Timeout := FTimeout
+  else
+    FTimeout := FEventer.Timeout;
+end;
+
+procedure TLConnection.FreeSocks;
+var
+  Tmp, Tmp2: TLSocket;
+begin
+  Tmp := FRootSock;
+  while Assigned(Tmp) do begin
+    Tmp2 := Tmp;
+    Tmp := Tmp.NextSock;
+    Tmp2.Free;
+  end;
+end;
+
+//*******************************TLUdp*********************************
+
+constructor TLUdp.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FTimeVal.tv_usec := 0;
+  FTimeVal.tv_sec := 0;
+end;
+
+procedure TLUdp.Disconnect;
+begin
+  if Assigned(FRootSock) then begin
+    FRootSock.Disconnect;
+    FreeAndNil(FRootSock);
+  end;
+end;
+
+function TLUdp.Connect(const Address: string; const APort: Word): Boolean;
+begin
+  Result := inherited Connect(Address, aPort);
+
+  if Assigned(FRootSock) and FRootSock.Connected then
+    Disconnect;
+
+  FRootSock := InitSocket(FSocketClass.Create);
+  FIterator := FRootSock;
+
+  Result := FRootSock.SetupSocket(APort, LADDR_ANY);
+  
+  FillAddressInfo(FRootSock.FPeerAddress, AF_INET, Address, aPort);
+
+  FRootSock.FConnected := true;
+  if Result then
+    RegisterWithEventer;
+end;
+
+function TLUdp.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
+begin
+  Result := False;
+
+  if Assigned(FRootSock) and FRootSock.Connected then
+    Disconnect;
+
+  FRootSock := InitSocket(FSocketClass.Create);
+  FIterator := FRootSock;
+  
+  if FRootSock.Listen(APort, AIntf) then begin
+    FillAddressInfo(FRootSock.FPeerAddress, AF_INET, LADDR_BR, aPort);
+  
+    FRootSock.FConnected := True;
+    RegisterWithEventer;
+  end;
+  Result := FRootSock.Connected;
+end;
+
+function TLUdp.Bail(const msg: string): Boolean;
+begin
+  Result  :=  False;
+
+  Disconnect;
+  ErrorEvent(msg, FRootSock);
+end;
+
+procedure TLUdp.SetAddress(const Address: string);
+var
+  n: Integer;
+  s: string;
+  p: Word;
+begin
+  n := Pos(':', Address);
+  if n > 0 then begin
+    s := Copy(Address, 1, n-1);
+    p := Word(StrToInt(Copy(Address, n+1, Length(Address))));
+
+    FillAddressInfo(FRootSock.FPeerAddress, AF_INET, s, p);
+  end else
+    FillAddressInfo(FRootSock.FPeerAddress, AF_INET, Address,
+                                            FRootSock.FPeerAddress.Port);
+end;
+
+function TLUdp.InitSocket(aSocket: TLSocket): TLSocket;
+begin
+  Result := FRootSock;
+  if not Assigned(FRootSock) then begin
+    Result := inherited InitSocket(aSocket);
+    aSocket.SocketType := SOCK_DGRAM;
+    aSocket.Protocol := LPROTO_UDP;
+  end;
+end;
+
+procedure TLUdp.ReceiveAction(aSocket: TLHandle);
+begin
+  with TLSocket(aSocket) do begin
+    FCanReceive := True;
+    ReceiveEvent(aSocket);
+  end;
+end;
+
+procedure TLUdp.SendAction(aSocket: TLHandle);
+begin
+  with TLSocket(aSocket) do begin
+    FCanSend := True;
+    IgnoreWrite := True;
+    CanSendEvent(aSocket);
+  end;
+end;
+
+procedure TLUdp.ErrorAction(aSocket: TLHandle; const msg: string);
+begin
+  Bail(msg);
+end;
+
+function TLUdp.IterNext: Boolean;
+begin
+  Result := False;
+end;
+
+procedure TLUdp.IterReset;
+begin
+end;
+
+procedure TLUdp.CallAction;
+begin
+  if Assigned(FEventer) then
+    FEventer.CallAction;
+end;
+
+function TLUdp.GetConnected: Boolean;
+begin
+  Result := False;
+  if Assigned(FRootSock) then
+  Result := FRootSock.Connected;
+end;
+
+function TLUdp.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then
+    Result := FRootSock.Get(aData, aSize);
+end;
+
+function TLUdp.GetMessage(out msg: string; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then
+    Result := FRootSock.GetMessage(msg);
+end;
+
+function TLUdp.SendMessage(const msg: string; aSocket: TLSocket = nil): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then
+    Result := FRootSock.SendMessage(msg)
+end;
+
+function TLUdp.SendMessage(const msg: string; const Address: string): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then begin
+    SetAddress(Address);
+    Result := FRootSock.SendMessage(msg)
+  end;
+end;
+
+function TLUdp.Send(const aData; const aSize: Integer; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then
+    Result := FRootSock.Send(aData, aSize)
+end;
+
+function TLUdp.Send(const aData; const aSize: Integer; const Address: string
+  ): Integer;
+begin
+  Result := 0;
+  if Assigned(FRootSock) then begin
+    SetAddress(Address);
+    Result := FRootSock.Send(aData, aSize);
+  end;
+end;
+
+//******************************TLTcp**********************************
+
+constructor TLTcp.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FIterator := nil;
+  FCount := 0;
+  FRootSock := nil;
+end;
+
+function TLTcp.Connect(const Address: string; const APort: Word): Boolean;
+begin
+  Result := inherited Connect(Address, aPort);
+  
+  if Assigned(FRootSock) then
+    Disconnect;
+    
+  FRootSock := InitSocket(FSocketClass.Create);
+  Result := FRootSock.Connect(Address, aPort);
+  
+  if Result then begin
+    Inc(FCount);
+    FIterator := FRootSock;
+    RegisterWithEventer;
+  end else begin
+    FreeAndNil(FRootSock);
+    FIterator := nil;
+  end;
+end;
+
+function TLTcp.Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean;
+begin
+  Result := false;
+  
+  if Assigned(FRootSock) then
+    Disconnect;
+  
+  FRootSock := InitSocket(FSocketClass.Create);
+  FRootSock.FIgnoreShutdown := True;
+  if FRootSock.Listen(APort, AIntf) then begin
+    FRootSock.FConnected := True;
+    FRootSock.FServerSocket := True;
+    RegisterWithEventer;
+    Result := true;
+  end;
+end;
+
+function TLTcp.Bail(const msg: string; aSocket: TLSocket): Boolean;
+begin
+  Result  :=  False;
+  
+  ErrorEvent(msg, aSocket);
+  if Assigned(aSocket) then
+    aSocket.Disconnect
+  else
+    Disconnect;
+end;
+
+procedure TLTcp.SocketDisconnect(aSocket: TLSocket);
+begin
+  if aSocket = FIterator then begin
+    if Assigned(FIterator.NextSock) then
+      FIterator := FIterator.NextSock
+    else if Assigned(FIterator.PrevSock) then
+      FIterator := FIterator.PrevSock
+    else FIterator := nil; // NOT iterreset, not reorganized yet
+    if Assigned(FIterator) and FIterator.FServerSocket then
+      FIterator := nil;
+  end;
+
+  if aSocket = FRootSock then
+    FRootSock := aSocket.NextSock;
+  if Assigned(aSocket.PrevSock) then
+    aSocket.PrevSock.NextSock := aSocket.NextSock;
+  if Assigned(aSocket.NextSock) then
+    aSocket.NextSock.PrevSock := aSocket.PrevSock;
+  Dec(FCount);
+end;
+
+function TLTcp.InitSocket(aSocket: TLSocket): TLSocket;
+begin
+  Result := inherited InitSocket(aSocket);
+  aSocket.SocketType := SOCK_STREAM;
+  aSocket.Protocol := LPROTO_TCP;
+  aSocket.FOnFree := @SocketDisconnect;
+end;
+
+function TLTcp.IterNext: Boolean;
+begin
+  Result := False;
+  if Assigned(FIterator.NextSock) then begin
+    FIterator := FIterator.NextSock;
+    Result := True;
+  end else IterReset;
+end;
+
+procedure TLTcp.IterReset;
+begin
+  if Assigned(FRootSock) and FRootSock.FServerSocket then
+    FIterator := FRootSock.NextSock
+  else
+    FIterator := FRootSock;
+end;
+
+procedure TLTcp.Disconnect;
+begin
+  FreeSocks;
+  FRootSock := nil;
+  FCount := 0;
+  FIterator := nil;
+end;
+
+procedure TLTcp.CallAction;
+begin
+  if Assigned(FEventer) then
+    FEventer.CallAction;
+end;
+
+procedure TLTcp.ConnectAction(aSocket: TLHandle);
+var
+  a: TInetSockAddr;
+  l: Longint;
+begin
+  with TLSocket(aSocket) do begin
+    l := SizeOf(a);
+    if Sockets.GetPeerName(FHandle, a, l) <> 0 then
+      Self.Bail('Error on connect: connection refused', TLSocket(aSocket))
+    else begin
+      FConnected := True;
+      FConnecting := False;
+      ConnectEvent(aSocket);
+    end;
+  end;
+end;
+
+procedure TLTcp.AcceptAction(aSocket: TLHandle);
+var
+  Tmp: TLSocket;
+begin
+  Tmp := InitSocket(FSocketClass.Create);
+  if Tmp.Accept(FRootSock.FHandle) then begin
+    if Assigned(FRootSock.FNextSock) then begin
+      Tmp.FNextSock := FRootSock.FNextSock;
+      FRootSock.FNextSock.FPrevSock := Tmp;
+    end;
+    FRootSock.FNextSock := Tmp;
+    Tmp.FPrevSock := FRootSock;
+    if not Assigned(FIterator) then
+      FIterator := Tmp;
+    Inc(FCount);
+    FEventer.AddHandle(Tmp);
+    AcceptEvent(Tmp);
+  end else Tmp.Free;
+end;
+
+procedure TLTcp.ReceiveAction(aSocket: TLHandle);
+begin
+  if (TLSocket(aSocket) = FRootSock) and TLSocket(aSocket).FServerSocket then
+    AcceptAction(aSocket)
+  else with TLSocket(aSocket) do begin
+    if Connected then begin
+      FCanReceive := True;
+      ReceiveEvent(aSocket);
+      if not Connected then begin
+        DisconnectEvent(aSocket);
+        aSocket.Free;
+      end;
+    end;
+  end;
+end;
+
+procedure TLTcp.SendAction(aSocket: TLHandle);
+begin
+  with TLSocket(aSocket) do begin
+    if Connecting then
+      ConnectAction(aSocket);
+    FCanSend := True;
+    IgnoreWrite := True;
+    CanSendEvent(aSocket);
+  end;
+end;
+
+procedure TLTcp.ErrorAction(aSocket: TLHandle; const msg: string);
+begin
+  with TLSocket(aSocket) do begin
+    if Connecting then
+      Self.Bail('Error on connect: connection refused' , TLSocket(aSocket))
+    else
+      Self.Bail(msg, TLSocket(aSocket));
+  end;
+end;
+
+function TLTcp.GetConnected: Boolean;
+var
+  Tmp: TLSocket;
+begin
+  Result := False;
+  Tmp := FRootSock;
+  while Assigned(Tmp) do begin
+    if Tmp.Connected then begin
+      Result := True;
+      Exit;
+    end else Tmp := Tmp.NextSock;
+  end;
+end;
+
+function TLTcp.GetConnecting: Boolean;
+begin
+  Result := False;
+  if Assigned(FRootSock) then
+    Result := FRootSock.Connecting;
+end;
+
+function TLTcp.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if not Assigned(aSocket) then
+    aSocket := FIterator;
+  if Assigned(aSocket) then
+    Result := aSocket.Get(aData, aSize);
+end;
+
+function TLTcp.GetMessage(out msg: string; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if not Assigned(aSocket) then
+    aSocket := FIterator;
+  if Assigned(aSocket) then
+    Result := aSocket.GetMessage(msg);
+end;
+
+function TLTcp.Send(const aData; const aSize: Integer; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  if not Assigned(aSocket) then
+    aSocket := FIterator;
+  if Assigned(aSocket) and (aSize > 0) then
+    Result := aSocket.Send(aData, aSize);
+end;
+
+function TLTcp.SendMessage(const msg: string; aSocket: TLSocket): Integer;
+begin
+  Result := Send(PChar(msg)^, Length(msg), aSocket);
+end;
+
+
+{ TLComponent }
+
+constructor TLComponent.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FCreator := Self;
+end;
+
+end.
+

utils/fppkg/lnet/lstrbuffer.pp

@@ -0,0 +1,91 @@
+{ Efficient string buffer helper
+
+  Copyright (C) 2006 Micha Nelissen
+
+  This library is Free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  
+  This license has been modified. See file LICENSE.ADDON for more information.
+  Should you find these sources without a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lStrBuffer;
+
+{$mode objfpc}{$h+}
+
+interface
+
+type
+  PStringBuffer = ^TStringBuffer;
+  TStringBuffer = record
+    Memory: pchar;
+    Pos: pchar;
+  end;
+
+function  InitStringBuffer(InitialSize: integer): TStringBuffer;
+procedure AppendString(var ABuffer: TStringBuffer; const ASource: string); overload;
+procedure AppendString(var ABuffer: TStringBuffer; const ASource: shortstring); overload;
+procedure AppendString(var ABuffer: TStringBuffer; ASource: pointer; ALength: PtrUInt); overload;
+procedure AppendString(var ABuffer: TStringBuffer; ASource: pchar); overload;
+procedure AppendChar(var ABuffer: TStringBuffer; AChar: char);
+
+implementation
+
+function  InitStringBuffer(InitialSize: integer): TStringBuffer;
+begin
+  Result.Memory := GetMem(InitialSize);
+  Result.Pos := Result.Memory;
+end;
+
+procedure AppendString(var ABuffer: TStringBuffer; ASource: pointer; ALength: PtrUInt);
+var
+  lPos, lSize: PtrUInt;
+begin
+  if ALength = 0 then exit;
+  lPos := PtrUInt(ABuffer.Pos - ABuffer.Memory);
+  lSize := PtrUInt(MemSize(ABuffer.Memory));
+  { reserve 2 extra spaces }
+  if lPos + ALength + 2 >= lSize then
+  begin
+    ReallocMem(ABuffer.Memory, lPos + ALength + lSize);
+    ABuffer.Pos := ABuffer.Memory + lPos;
+  end;
+  Move(ASource^, ABuffer.Pos^, ALength);
+  Inc(ABuffer.Pos, ALength);
+end;
+
+procedure AppendString(var ABuffer: TStringBuffer; ASource: pchar);
+begin
+  if ASource = nil then exit;
+  AppendString(ABuffer, ASource, StrLen(ASource)); 
+end;
+
+procedure AppendString(var ABuffer: TStringBuffer; const ASource: shortstring);
+begin
+  AppendString(ABuffer, @ASource[1], Length(ASource));
+end;
+
+procedure AppendString(var ABuffer: TStringBuffer; const ASource: string);
+begin
+  AppendString(ABuffer, PChar(ASource), Length(ASource));
+end;
+
+procedure AppendChar(var ABuffer: TStringBuffer; AChar: char);
+begin
+  ABuffer.Pos^ := AChar;
+  Inc(ABuffer.Pos);
+end;
+
+end.

utils/fppkg/lnet/ltelnet.pp

@@ -0,0 +1,491 @@
+{ lTelnet CopyRight (C) 2004-2006 Ales Katona
+
+  This library is Free software; you can rediStribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+  This license has been modified. See File LICENSE for more inFormation.
+  Should you find these sources withOut a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lTelnet;
+
+{$mode objfpc}{$H+}
+//{$define debug}
+
+interface
+
+uses
+  Classes, lNet, lControlStack;
+  
+const
+  // Telnet printer signals
+  TS_NUL         = #0;
+  TS_ECHO        = #1;
+  TS_SGA         = #3; // Surpass go-ahead
+  TS_BEL         = #7;
+  TS_BS          = #8;
+  TS_HT          = #9;
+  TS_LF          = #10;
+  TS_VT          = #11;
+  TS_FF          = #12;
+  TS_CR          = #13;
+  // Telnet control signals
+  TS_NAWS        = #31;
+  TS_DATA_MARK   = #128;
+  TS_BREAK       = #129;
+  TS_HYI         = #133; // Hide Your Input
+  // Data types codes
+  TS_STDTELNET   = #160;
+  TS_TRANSPARENT = #161;
+  TS_EBCDIC      = #162;
+  // Control bytes
+  TS_SE          = #240;
+  TS_NOP         = #241;
+  TS_GA          = #249; // go ahead currently ignored(full duplex)
+  TS_SB          = #250;
+  TS_WILL        = #251;
+  TS_WONT        = #252;
+  TS_DO          = #253;
+  TS_DONT        = #254;
+  // Mother of all power
+  TS_IAC         = #255;
+  
+type
+  TLTelnetClient = class;
+
+  TLTelnetControlChars = set of Char;
+
+  TLHowEnum = (TE_WILL = 251, TE_WONT, TE_DO, TE_DONW);
+  
+  { TLTelnet }
+
+  TLTelnet = class(TLComponent, ILDirect)
+   protected
+    FStack: TLControlStack;
+    FConnection: TLTcp;
+    FPossible: TLTelnetControlChars;
+    FActive: TLTelnetControlChars;
+    FOutput: TMemoryStream;
+    FOperation: Char;
+    FCommandCharIndex: Byte;
+    FOnReceive: TLSocketEvent;
+    FOnConnect: TLSocketEvent;
+    FOnDisconnect: TLSocketEvent;
+    FOnError: TLSocketErrorEvent;
+    FCommandArgs: string[3];
+    FOrders: TLTelnetControlChars;
+    FConnected: Boolean;
+    function Question(const Command: Char; const Value: Boolean): Char;
+    
+    function GetTimeout: DWord;
+    procedure SetTimeout(const Value: DWord);
+
+    function GetSocketClass: TLSocketClass;
+    procedure SetSocketClass(Value: TLSocketClass);
+    
+    procedure StackFull;
+    
+    procedure DoubleIAC(var s: string);
+    
+    procedure TelnetParse(const msg: string);
+    
+    procedure React(const Operation, Command: Char); virtual; abstract;
+    
+    procedure SendCommand(const Command: Char; const Value: Boolean); virtual; abstract;
+   public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+    
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    
+    function OptionIsSet(const Option: Char): Boolean;
+    function RegisterOption(const aOption: Char; const aCommand: Boolean): Boolean;
+    procedure SetOption(const Option: Char);
+    procedure UnSetOption(const Option: Char);
+    
+    procedure Disconnect; override;
+    
+    procedure SendCommand(const aCommand: Char; const How: TLHowEnum); virtual;
+   public
+    property Output: TMemoryStream read FOutput;
+    property Connected: Boolean read FConnected;
+    property Timeout: DWord read GetTimeout write SetTimeout;
+    property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
+    property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
+    property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
+    property OnError: TLSocketErrorEvent read FOnError write FOnError;
+    property Connection: TLTCP read FConnection;
+    property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
+  end;
+
+  { TLTelnetClient }
+
+  { TLTelnetClient }
+
+  TLTelnetClient = class(TLTelnet, ILClient)
+   protected
+    FLocalEcho: Boolean;
+    procedure OnEr(const msg: string; aSocket: TLSocket);
+    procedure OnDs(aSocket: TLSocket);
+    procedure OnRe(aSocket: TLSocket);
+    procedure OnCo(aSocket: TLSocket);
+    
+    procedure React(const Operation, Command: Char); override;
+    
+    procedure SendCommand(const Command: Char; const Value: Boolean); override;
+   public
+    constructor Create(aOwner: TComponent); override;
+    
+    function Connect(const anAddress: string; const aPort: Word): Boolean;
+    function Connect: Boolean;
+    
+    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
+    
+    function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
+    
+    procedure CallAction; override;
+   public
+    property LocalEcho: Boolean read FLocalEcho write FLocalEcho;
+  end;
+  
+implementation
+
+uses
+  SysUtils;
+
+var
+  zz: Char;
+  TNames: array[Char] of string;
+
+//*******************************TLTelnetClient********************************
+
+constructor TLTelnet.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FConnection := TLTCP.Create(aOwner);
+  FOutput := TMemoryStream.Create;
+  FCommandCharIndex := 0;
+  FStack := TLControlStack.Create;
+  FStack.OnFull := @StackFull;
+end;
+
+destructor TLTelnet.Destroy;
+begin
+  Disconnect;
+  FOutput.Free;
+  FConnection.Free;
+  FStack.Free;
+  inherited Destroy;
+end;
+
+function TLTelnet.Question(const Command: Char; const Value: Boolean): Char;
+begin
+  Result := TS_NOP;
+  if Value then begin
+    if Command in FOrders then
+      Result := TS_DO
+    else
+      Result := TS_WILL;
+  end else begin
+    if Command in FOrders then
+      Result := TS_DONT
+    else
+      Result := TS_WONT;
+  end;
+end;
+
+function TLTelnet.GetSocketClass: TLSocketClass;
+begin
+  Result := FConnection.SocketClass;
+end;
+
+function TLTelnet.GetTimeout: DWord;
+begin
+  Result := FConnection.Timeout;
+end;
+
+procedure TLTelnet.SetSocketClass(Value: TLSocketClass);
+begin
+  FConnection.SocketClass := Value;
+end;
+
+procedure TLTelnet.SetTimeout(const Value: DWord);
+begin
+  FConnection.Timeout := Value;
+end;
+
+procedure TLTelnet.StackFull;
+begin
+  {$ifdef debug}
+  Writeln('**STACKFULL**');
+  {$endif}
+  if FStack[1] = TS_IAC then
+    begin
+      FOutput.WriteByte(Byte(FStack[1]));
+      FOutput.WriteByte(Byte(FStack[2]));
+    end else React(FStack[1], FStack[2]);
+  FStack.Clear;
+end;
+
+procedure TLTelnet.DoubleIAC(var s: string);
+var
+  i: Longint;
+begin
+  i := 0;
+  if Length(s) > 0 then
+    while i < Length(s) do begin
+      Inc(i);
+      if s[i] = TS_IAC then begin
+        Insert(TS_IAC, s, i);
+        Inc(i, 2);
+      end;
+    end;
+end;
+
+procedure TLTelnet.TelnetParse(const msg: string);
+var
+  i: Longint;
+begin
+  for i := 1 to Length(msg) do
+    if (FStack.ItemIndex > 0) or (msg[i] = TS_IAC) then begin
+      if msg[i] = TS_GA then
+        FStack.Clear
+      else
+        FStack.Push(msg[i])
+    end else
+      FOutput.WriteByte(Byte(msg[i]));
+end;
+
+function TLTelnet.OptionIsSet(const Option: Char): Boolean;
+begin
+  Result := False;
+  Result := Option in FActive;
+end;
+
+function TLTelnet.RegisterOption(const aOption: Char;
+                                     const aCommand: Boolean): Boolean;
+begin
+  Result := False;
+  if not (aOption in FPossible) then begin
+    FPossible := FPossible + [aOption];
+    if aCommand then
+      FOrders := FOrders + [aOption];
+    Result := True;
+  end;
+end;
+
+procedure TLTelnet.SetOption(const Option: Char);
+begin
+  if Option in FPossible then
+    SendCommand(Option, True);
+end;
+
+procedure TLTelnet.UnSetOption(const Option: Char);
+begin
+  if Option in FPossible then
+    SendCommand(Option, False);
+end;
+
+procedure TLTelnet.Disconnect;
+begin
+  FConnection.Disconnect;
+  FConnected := False;
+end;
+
+procedure TLTelnet.SendCommand(const aCommand: Char; const How: TLHowEnum);
+begin
+  {$ifdef debug}
+  Writeln('**SENT** ', TNames[Char(How)], ' ', TNames[aCommand]);
+  {$endif}
+  FConnection.SendMessage(TS_IAC + Char(How) + aCommand);
+end;
+
+//****************************TLTelnetClient*****************************
+
+constructor TLTelnetClient.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FConnection.OnError := @OnEr;
+  FConnection.OnDisconnect := @OnDs;
+  FConnection.OnReceive := @OnRe;
+  FConnection.OnConnect := @OnCo;
+  FConnected := False;
+  FPossible := [TS_ECHO, TS_HYI, TS_SGA];
+  FActive := [];
+  FOrders := [];
+end;
+
+procedure TLTelnetClient.OnEr(const msg: string; aSocket: TLSocket);
+begin
+  if Assigned(FOnError) then
+    FOnError(msg, aSocket)
+  else
+    FOutput.Write(Pointer(msg)^, Length(msg));
+end;
+
+procedure TLTelnetClient.OnDs(aSocket: TLSocket);
+begin
+  if Assigned(FOnDisconnect) then
+    FOnDisconnect(aSocket);
+end;
+
+procedure TLTelnetClient.OnRe(aSocket: TLSocket);
+var
+  s: string;
+begin
+  if aSocket.GetMessage(s) > 0 then begin
+    TelnetParse(s);
+    if Assigned(FOnReceive) then
+      FOnReceive(aSocket);
+  end;
+end;
+
+procedure TLTelnetClient.OnCo(aSocket: TLSocket);
+begin
+  FConnected := True;
+  if Assigned(FOnConnect) then
+    FOnConnect(aSocket);
+end;
+
+procedure TLTelnetClient.React(const Operation, Command: Char);
+
+  procedure Accept(const Operation, Command: Char);
+  begin
+    FActive := FActive + [Command];
+    {$ifdef debug}
+    Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]);
+    {$endif}
+    FConnection.SendMessage(TS_IAC + Operation + Command);
+  end;
+  
+  procedure Refuse(const Operation, Command: Char);
+  begin
+    FActive := FActive - [Command];
+    {$ifdef debug}
+    Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]);
+    {$endif}
+    FConnection.SendMessage(TS_IAC + Operation + Command);
+  end;
+  
+begin
+  {$ifdef debug}
+  Writeln('**GOT** ', TNames[Operation], ' ', TNames[Command]);
+  {$endif}
+  case Operation of
+    TS_DO   : if Command in FPossible then Accept(TS_WILL, Command)
+              else Refuse(TS_WONT, Command);
+              
+    TS_DONT : if Command in FPossible then Refuse(TS_WONT, Command);
+    
+    TS_WILL : if Command in FPossible then FActive := FActive + [Command]
+              else Refuse(TS_DONT, Command);
+                 
+    TS_WONT : if Command in FPossible then FActive := FActive - [Command];
+  end;
+end;
+
+procedure TLTelnetClient.SendCommand(const Command: Char; const Value: Boolean);
+begin
+  if FConnected then begin
+    {$ifdef debug}
+    Writeln('**SENT** ', TNames[Question(Command, Value)], ' ', TNames[Command]);
+    {$endif}
+    case Question(Command, Value) of
+      TS_WILL : FActive := FActive + [Command];
+    end;
+    FConnection.SendMessage(TS_IAC + Question(Command, Value) + Command);
+  end;
+end;
+
+function TLTelnetClient.Connect(const anAddress: string; const aPort: Word): Boolean;
+begin
+  Result := FConnection.Connect(anAddress, aPort);
+end;
+
+function TLTelnetClient.Connect: Boolean;
+begin
+  Result  :=  FConnection.Connect(FHost, FPort);
+end;
+
+function TLTelnetClient.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+begin
+  Result := FOutput.Read(aData, aSize);
+  if FOutput.Position = FOutput.Size then
+    FOutput.Clear;
+end;
+
+function TLTelnetClient.GetMessage(out msg: string; aSocket: TLSocket): Integer;
+begin
+  Result := 0;
+  msg := '';
+  if FOutput.Size > 0 then begin
+    FOutput.Position := 0;
+    SetLength(msg, FOutput.Size);
+    Result := FOutput.Read(PChar(msg)^, Length(msg));
+    FOutput.Clear;
+  end;
+end;
+
+function TLTelnetClient.Send(const aData; const aSize: Integer;
+  aSocket: TLSocket): Integer;
+var
+  Tmp: string;
+begin
+  {$ifdef debug}
+  Writeln('**SEND START** ');
+  {$endif}
+  Result := 0;
+  if aSize > 0 then begin
+    SetLength(Tmp, aSize);
+    Move(aData, PChar(Tmp)^, aSize);
+    DoubleIAC(Tmp);
+    if LocalEcho and (not OptionIsSet(TS_ECHO)) and (not OptionIsSet(TS_HYI)) then
+      FOutput.Write(PChar(Tmp)^, Length(Tmp));
+    Result := FConnection.SendMessage(Tmp);
+  end;
+  {$ifdef debug}
+  Writeln('**SEND END** ');
+  {$endif}
+end;
+
+function TLTelnetClient.SendMessage(const msg: string; aSocket: TLSocket
+  ): Integer;
+begin
+  Result := Send(PChar(msg)^, Length(msg));
+end;
+
+procedure TLTelnetClient.CallAction;
+begin
+  FConnection.CallAction;
+end;
+
+initialization
+  for zz := #0 to #255 do
+    TNames[zz] := IntToStr(Ord(zz));
+  TNames[#1] := 'TS_ECHO';
+  TNames[#133] := 'TS_HYI';
+  TNames[#251] := 'TS_WILL';
+  TNames[#252] := 'TS_WONT';
+  TNames[#253] := 'TS_DO';
+  TNames[#254] := 'TS_DONT';
+
+end.
+

utils/fppkg/lnet/lwebserver.pp

@@ -0,0 +1,1263 @@
+{ Web server component, built on the HTTP server component
+
+  Copyright (C) 2006 Micha Nelissen
+
+  This library is Free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 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 Library General Public License
+  for more details.
+
+  You should have received a Copy of the GNU Library General Public License
+  along with This library; if not, Write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  
+  This license has been modified. See file LICENSE.ADDON for more information.
+  Should you find these sources without a LICENSE File, please contact
+  me at [email protected]
+}
+
+unit lwebserver;
+
+{$mode objfpc}{$h+}
+{$inline on}
+
+interface
+
+uses
+  sysutils, classes, lnet, lhttp, lhttputil, lmimetypes, levents, 
+  lprocess, process, lfastcgi, fastcgi;
+
+type
+  TLMultipartParameter = (mpContentType, mpContentDisposition, mpContentTransferEncoding,
+    mpContentID, mpContentDescription);
+  TLMultipartState = (msStart, msBodypartHeader, msBodypartData);
+
+const
+  URIParamSepChar: char = '&';
+  CookieSepChar: char = ';';
+  FormURLContentType: pchar = 'application/x-www-form-urlencoded';
+  MultipartContentType: pchar = 'multipart/form-data';
+  MPParameterStrings: array[TLMultipartParameter] of string =
+    ('Content-Type', 'Content-Disposition', 'Content-Transfer-Encoding',
+     'Content-ID', 'Content-Discription');
+
+type
+  TDocumentHandler = class;
+  TFileHandler = class;
+
+  TFileOutput = class(TBufferOutput)
+  protected
+    FFile: file;
+
+    function GetSize: integer;
+    function FillBuffer: TWriteBlockStatus; override;
+  public
+    constructor Create(ASocket: TLHTTPSocket);
+    destructor Destroy; override;
+
+    function  Open(const AFileName: string): boolean;
+
+    property Size: integer read GetSize;
+  end;
+
+  TCGIOutput = class(TBufferOutput)
+  protected
+    FParsePos: pchar;
+    FReadPos: integer;
+    FParsingHeaders: boolean;
+    FDocumentRoot: string;
+    FExtraPath: string;
+    FEnvPath: string;
+    FScriptFileName: string;
+    FScriptName: string;
+   
+    procedure AddEnvironment(const AName, AValue: string); virtual; abstract;
+    procedure AddHTTPParam(const AName: string; AParam: TLHTTPParameter);
+    function  ParseHeaders: boolean;
+    procedure CGIOutputError; virtual; abstract;
+    procedure WriteCGIBlock;
+    function  WriteCGIData: TWriteBlockStatus; virtual; abstract;
+  public
+    constructor Create(ASocket: TLHTTPSocket);
+    destructor Destroy; override;
+
+    function  FillBuffer: TWriteBlockStatus; override;
+    procedure StartRequest; virtual;
+   
+    property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
+    property EnvPath: string read FEnvPath write FEnvPath;
+    property ExtraPath: string read FExtraPath write FExtraPath;
+    property ScriptFileName: string read FScriptFileName write FScriptFileName;
+    property ScriptName: string read FScriptName write FScriptName;
+  end;
+
+  TSimpleCGIOutput = class(TCGIOutput)
+  protected
+    FProcess: TLProcess;
+
+    procedure AddEnvironment(const AName, AValue: string); override;
+    procedure CGIProcNeedInput(AHandle: TLHandle);
+    procedure CGIProcHasOutput(AHandle: TLHandle);
+    procedure CGIProcHasStderr(AHandle: TLHandle);
+    procedure DoneInput; override;
+    function  HandleInput(ABuffer: pchar; ASize: integer): integer; override;
+    procedure CGIOutputError; override;
+    function  WriteCGIData: TWriteBlockStatus; override;
+  public
+    constructor Create(ASocket: TLHTTPSocket);
+    destructor Destroy; override;
+
+    procedure  StartRequest; override;
+
+    property Process: TLProcess read FProcess;
+  end;
+
+  TFastCGIOutput = class(TCGIOutput)
+  protected
+    FRequest: TLFastCGIRequest;
+
+    procedure AddEnvironment(const AName, AValue: string); override;
+    procedure CGIOutputError; override;
+    procedure DoneInput; override;
+    procedure RequestEnd(ARequest: TLFastCGIRequest);
+    procedure RequestNeedInput(ARequest: TLFastCGIRequest);
+    procedure RequestHasOutput(ARequest: TLFastCGIRequest);
+    procedure RequestHasStderr(ARequest: TLFastCGIRequest);
+    function  HandleInput(ABuffer: pchar; ASize: integer): integer; override;
+    function  WriteCGIData: TWriteBlockStatus; override;
+    function  WriteBlock: TWriteBlockStatus; override;
+  public
+    constructor Create(ASocket: TLHTTPSocket);
+    destructor Destroy; override;
+
+    procedure StartRequest; override;
+
+    property Request: TLFastCGIRequest read FRequest write FRequest;
+  end;
+
+  TCGIHandler = class(TURIHandler)
+  protected
+    FScriptPathPrefix: string;
+    FCGIRoot: string;
+    FDocumentRoot: string;
+    FEnvPath: string;
+
+    function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
+  public
+    property CGIRoot: string read FCGIRoot write FCGIRoot;
+    property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
+    property EnvPath: string read FEnvPath write FEnvPath;
+    property ScriptPathPrefix: string read FScriptPathPrefix write FScriptPathPrefix;
+  end;
+
+  TDocumentRequest = record
+    Socket: TLHTTPServerSocket;
+    Document: string;
+    URIPath: string;
+    ExtraPath: string;
+    Info: TSearchRec;
+    InfoValid: boolean;
+  end;
+
+  TDocumentHandler = class(TObject)
+  private
+    FNext: TDocumentHandler;
+  protected
+    FFileHandler: TFileHandler;
+
+    procedure RegisterWithEventer(AEventer: TLEventer); virtual;
+  public
+    function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; virtual; abstract;
+
+    property FileHandler: TFileHandler read FFileHandler;
+  end;
+
+  { TFileHandler }
+
+  TFileHandler = class(TURIHandler)
+  protected
+    FDocHandlerList: TDocumentHandler;
+    FDirIndexList: TStrings;
+  protected
+    FDocumentRoot: string;
+    FMimeTypeFile: string;
+
+    procedure SetMimeTypeFile(const AValue: string);
+    function HandleFile(const ARequest: TDocumentRequest): TOutputItem;
+    function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
+    procedure RegisterWithEventer(AEventer: TLEventer); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    
+    procedure RegisterHandler(AHandler: TDocumentHandler);
+
+    property DirIndexList: TStrings read FDirIndexList;
+    property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
+    property MimeTypeFile: string read FMimeTypeFile write SetMimeTypeFile;
+  end;
+
+  TPHPCGIHandler = class(TDocumentHandler)
+  protected
+    FAppName: string;
+    FEnvPath: string;
+  public
+    function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; override;
+
+    property AppName: string read FAppName write FAppName;
+    property EnvPath: string read FEnvPath write FEnvPath;
+  end;
+
+  TPHPFastCGIHandler = class(TDocumentHandler)
+  protected
+    FPool: TLFastCGIPool;
+    FEnvPath: string;
+
+    function  GetAppEnv: string;
+    function  GetAppName: string;
+    function  GetHost: string;
+    function  GetPort: integer;
+    procedure RegisterWithEventer(AEventer: TLEventer); override;
+    procedure SetAppEnv(NewEnv: string);
+    procedure SetAppName(NewName: string);
+    procedure SetHost(NewHost: string);
+    procedure SetPort(NewPort: integer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; override;
+
+    property AppEnv: string read GetAppEnv write SetAppEnv;
+    property AppName: string read GetAppName write SetAppName;
+    property EnvPath: string read FEnvPath write FEnvPath;
+    property Host: string read GetHost write SetHost;
+    property Pool: TLFastCGIPool read FPool;
+    property Port: integer read GetPort write SetPort;
+  end;
+
+  { Forms }
+
+  TFormOutput = class;
+
+  TFillBufferEvent = procedure(AFormOutput: TFormOutput; var AStatus: TWriteBlockStatus);
+  THandleInputMethod = function(ABuffer: pchar; ASize: integer): integer of object;
+
+  TFormOutput = class(TBufferOutput)
+  protected
+    FBoundary: pchar;
+    FRequestVars: TStrings;
+    FMPParameters: array[TLMultipartParameter] of pchar;
+    FMPState: TLMultipartState;
+    FOnExtraHeaders: TNotifyEvent;
+    FOnFillBuffer: TFillBufferEvent;
+    FHandleInput: THandleInputMethod;
+
+    procedure DoneInput; override;
+    function  FillBuffer: TWriteBlockStatus; override;
+    function  FindBoundary(ABuffer: pchar): pchar;
+    function  HandleInput(ABuffer: pchar; ASize: integer): integer; override;
+    function  HandleInputDiscard(ABuffer: pchar; ASize: integer): integer;
+    function  HandleInputFormURL(ABuffer: pchar; ASize: integer): integer;
+    function  HandleInputMultipart(ABuffer: pchar; ASize: integer): integer;
+    procedure ParseMultipartHeader(ABuffer, ALineEnd: pchar);
+  public
+    constructor Create(ASocket: TLHTTPSocket);
+    destructor Destroy; override;
+
+    function AddVariables(Variables: pchar; ASize: integer; SepChar: char): integer;
+    procedure DeleteCookie(const AName: string; const APath: string = '/'; 
+        const ADomain: string = '');
+    procedure SetCookie(const AName, AValue: string; const AExpires: TDateTime; 
+        const APath: string = '/'; const ADomain: string = '');
+
+    property OnExtraHeaders: TNotifyEvent read FOnExtraHeaders write FOnExtraHeaders;
+    property OnFillBuffer: TFillBufferEvent read FOnFillBuffer write FOnFillBuffer;
+  end;
+
+  THandleURIEvent = function(ASocket: TLHTTPServerSocket): TFormOutput;
+
+  TFormHandler = class(TURIHandler)
+  protected
+    FOnHandleURI: THandleURIEvent;
+
+    function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
+    procedure SelectMultipart(AFormOutput: TFormOutput; AContentType: pchar);
+  public
+    property OnHandleURI: THandleURIEvent read FOnHandleURI write FOnHandleURI;
+  end;
+
+var
+  EnableWriteln: Boolean = True;
+
+implementation
+
+uses
+  lstrbuffer;
+
+{ Example handlers }
+
+const
+  InputBufferEmptyToWriteStatus: array[boolean] of TWriteBlockStatus =
+    (wsPendingData, wsWaitingData);
+  
+procedure InternalWrite(const s: string);
+begin
+  if EnableWriteln then
+    Writeln(s);
+end;
+
+procedure TDocumentHandler.RegisterWithEventer(AEventer: TLEventer);
+begin
+end;
+
+function TCGIHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
+var
+  lOutput: TSimpleCGIOutput;
+  lExecPath: string;
+begin
+  if StrLComp(ASocket.RequestInfo.Argument, PChar(ScriptPathPrefix),
+      Length(ScriptPathPrefix)) = 0 then
+  begin
+    lOutput := TSimpleCGIOutput.Create(ASocket);
+    lOutput.DocumentRoot := FDocumentRoot;
+    lOutput.EnvPath := FEnvPath;
+    lOutput.Process.CurrentDirectory := FCGIRoot;
+    lExecPath := (ASocket.RequestInfo.Argument+Length(ScriptPathPrefix));
+    DoDirSeparators(lExecPath);
+    lExecPath := FCGIRoot+lExecPath;
+    if SeparatePath(lExecPath, lOutput.ExtraPath, faAnyFile and not faDirectory) then
+    begin
+      lOutput.Process.CommandLine := lExecPath;
+      lOutput.ScriptFileName := lExecPath;
+      lOutput.ScriptName := Copy(lExecPath, Length(FCGIRoot), 
+        Length(lExecPath)-Length(FCGIRoot)+1);
+      lOutput.StartRequest;
+    end else
+      ASocket.ResponseInfo.Status := hsNotFound;
+    Result := lOutput;
+  end else
+    Result := nil;
+end;
+
+constructor TFileHandler.Create;
+begin
+  inherited;
+
+  FDirIndexList := TStringList.Create;
+end;
+
+destructor TFileHandler.Destroy;
+begin
+  FreeAndNil(FDirIndexList);
+
+  inherited;
+end;
+
+procedure TFileHandler.RegisterWithEventer(AEventer: TLEventer);
+var
+  lHandler: TDocumentHandler;
+begin
+  lHandler := FDocHandlerList;
+  while lHandler <> nil do
+  begin
+    lHandler.RegisterWithEventer(AEventer);
+    lHandler := lHandler.FNext;
+  end;
+end;
+
+procedure TFileHandler.SetMimeTypeFile(const AValue: string);
+begin
+  FMimeTypeFile:=AValue;
+  InitMimeList(aValue);
+end;
+
+function TFileHandler.HandleFile(const ARequest: TDocumentRequest): TOutputItem;
+var
+  lFileOutput: TFileOutput;
+  lReqInfo: PRequestInfo;
+  lRespInfo: PResponseInfo;
+  lHeaderOut: PHeaderOutInfo;
+  lIndex: integer;
+begin
+  Result := nil;
+  if ARequest.InfoValid then
+  begin
+    lReqInfo := @ARequest.Socket.RequestInfo;
+    lRespInfo := @ARequest.Socket.ResponseInfo;
+    lHeaderOut := @ARequest.Socket.HeaderOut;
+    if not (lReqInfo^.RequestType in [hmHead, hmGet]) then
+    begin
+      lRespInfo^.Status := hsNotAllowed;
+    end else begin
+      lFileOutput := TFileOutput.Create(ARequest.Socket);
+      if lFileOutput.Open(ARequest.Document) then
+      begin
+        lRespInfo^.Status := hsOK;
+        lHeaderOut^.ContentLength := ARequest.Info.Size;
+        lRespInfo^.LastModified := LocalTimeToGMT(FileDateToDateTime(ARequest.Info.Time));
+        lIndex := MimeList.IndexOf(ExtractFileExt(ARequest.Document));
+        if lIndex >= 0 then
+          lRespInfo^.ContentType := TStringObject(MimeList.Objects[lIndex]).Str;
+        Result := lFileOutput;
+        ARequest.Socket.StartResponse(lFileOutput);
+      end else
+        lFileOutput.Free;
+    end;
+  end;
+end;
+
+function TFileHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
+var
+  lDocRequest: TDocumentRequest;
+  lHandler: TDocumentHandler;
+  lTempDoc: string;
+  lDirIndexFound: boolean;
+  I: integer;
+begin
+  Result := nil;
+  lDocRequest.Socket := ASocket;
+  lDocRequest.URIPath := ASocket.RequestInfo.Argument;
+  lDocRequest.Document := lDocRequest.URIPath;
+  DoDirSeparators(LDocRequest.Document);
+  lDocRequest.Document := IncludeTrailingPathDelimiter(FDocumentRoot)+lDocRequest.Document;
+  lDocRequest.InfoValid := SeparatePath(lDocRequest.Document,lDocRequest.ExtraPath, 
+    faAnyFile, @lDocRequest.Info);
+  if not lDocRequest.InfoValid then
+    exit;
+  if (lDocRequest.Info.Attr and faDirectory) <> 0 then
+  begin
+    lDirIndexFound := false;
+    { if non-trivial ExtraPath, then it's not a pure directory request, so do
+      not show default directory document }
+    if lDocRequest.ExtraPath = PathDelim then
+    begin
+      lDocRequest.Document := IncludeTrailingPathDelimiter(lDocRequest.Document);
+      for I := 0 to FDirIndexList.Count - 1 do
+      begin
+        lTempDoc := lDocRequest.Document + FDirIndexList.Strings[I];
+        lDocRequest.InfoValid := FindFirst(lTempDoc, 
+          faAnyFile and not faDirectory, lDocRequest.Info) = 0;
+        FindClose(lDocRequest.Info);
+        if lDocRequest.InfoValid and ((lDocRequest.Info.Attr and faDirectory) = 0) then
+        begin
+          lDocRequest.Document := lTempDoc;
+          lDirIndexFound := true;
+          break;
+        end;
+      end;
+    end;
+    { requested a directory, but no source to show }
+    if not lDirIndexFound then exit;
+  end;
+
+  lHandler := FDocHandlerList;
+  while lHandler <> nil do
+  begin
+    Result := lHandler.HandleDocument(lDocRequest);
+    if Result <> nil then exit;
+    if ASocket.ResponseInfo.Status <> hsOK then exit;
+    lHandler := lHandler.FNext;
+  end;
+
+  { no dynamic handler, see if it's a plain file }
+  Result := HandleFile(lDocRequest);
+end;
+
+procedure TFileHandler.RegisterHandler(AHandler: TDocumentHandler);
+begin
+  if AHandler = nil then exit;
+  AHandler.FFileHandler := Self;
+  AHandler.FNext := FDocHandlerList;
+  FDocHandlerList := AHandler;
+end;
+
+function TPHPCGIHandler.HandleDocument(const ARequest: TDocumentRequest): TOutputItem;
+var
+  lOutput: TSimpleCGIOutput;
+begin
+  if ExtractFileExt(ARequest.Document) = '.php' then
+  begin
+    lOutput := TSimpleCGIOutput.Create(ARequest.Socket);
+    lOutput.DocumentRoot := FFileHandler.DocumentRoot;
+    lOutput.Process.CommandLine := FAppName;
+    lOutput.ScriptName := ARequest.URIPath;
+    lOutput.ScriptFileName := ARequest.Document;
+    lOutput.ExtraPath := ARequest.ExtraPath;
+    lOutput.EnvPath := FEnvPath;
+    lOutput.StartRequest;
+    Result := lOutput;
+  end else
+    Result := nil;
+end;
+
+constructor TPHPFastCGIHandler.Create;
+begin
+  inherited;
+  FPool := TLFastCGIPool.Create;
+end;
+
+destructor TPHPFastCGIHandler.Destroy;
+begin
+  inherited;
+  FPool.Free;
+end;
+
+function  TPHPFastCGIHandler.GetAppEnv: string;
+begin
+  Result := FPool.AppEnv;
+end;
+
+function  TPHPFastCGIHandler.GetAppName: string;
+begin
+  Result := FPool.AppName;
+end;
+
+function  TPHPFastCGIHandler.GetHost: string;
+begin
+  Result := FPool.Host;
+end;
+
+function  TPHPFastCGIHandler.GetPort: integer;
+begin
+  Result := FPool.Port;
+end;
+
+procedure TPHPFastCGIHandler.SetAppEnv(NewEnv: string);
+begin
+  FPool.AppEnv := NewEnv;
+end;
+
+procedure TPHPFastCGIHandler.SetAppName(NewName: string);
+begin
+  FPool.AppName := NewName;
+end;
+
+procedure TPHPFastCGIHandler.SetHost(NewHost: string);
+begin
+  FPool.Host := NewHost;
+end;
+
+procedure TPHPFastCGIHandler.SetPort(NewPort: integer);
+begin
+  FPool.Port := NewPort;
+end;
+
+procedure TPHPFastCGIHandler.RegisterWithEventer(AEventer: TLEventer);
+begin
+  FPool.Eventer := AEventer;
+end;
+
+function TPHPFastCGIHandler.HandleDocument(const ARequest: TDocumentRequest): TOutputItem;
+var
+  lOutput: TFastCGIOutput;
+  fcgiRequest: TLFastCGIRequest;
+begin
+  if ExtractFileExt(ARequest.Document) = '.php' then
+  begin
+    fcgiRequest := FPool.BeginRequest(FCGI_RESPONDER);
+    if fcgiRequest <> nil then
+    begin
+      lOutput := TFastCGIOutput.Create(ARequest.Socket);
+      lOutput.DocumentRoot := FFileHandler.DocumentRoot;
+      lOutput.ScriptName := ARequest.URIPath;
+      lOutput.ScriptFileName := ARequest.Document;
+      lOutput.ExtraPath := ARequest.ExtraPath;
+      lOutput.EnvPath := FEnvPath;
+      lOutput.Request := fcgiRequest;
+      ARequest.Socket.SetupEncoding(lOutput);
+      lOutput.StartRequest;
+      Result := lOutput;
+    end else begin
+      ARequest.Socket.ResponseInfo.Status := hsInternalError;
+      ARequest.Socket.StartResponse(nil);
+      Result := nil;
+    end;
+  end else
+    Result := nil;
+end;
+
+{ Output Items }
+
+constructor TFileOutput.Create(ASocket: TLHTTPSocket);
+begin
+  inherited;
+  FEof := true;
+end;
+
+destructor TFileOutput.Destroy;
+begin
+  inherited;
+  
+  if not FEof then
+    Close(FFile);
+end;
+
+function TFileOutput.Open(const AFileName: string): boolean;
+begin
+  {$I-}
+  FileMode := 0;
+  Assign(FFile, AFileName);
+  Reset(FFile,1);
+  {$I+}
+  Result := IOResult = 0;
+  FEof := false;
+end;
+
+function TFileOutput.GetSize: integer; inline;
+begin
+  Result := FileSize(FFile);
+end;
+
+function TFileOutput.FillBuffer: TWriteBlockStatus;
+var
+  lRead: integer;
+begin
+  if FEof then 
+    exit(wsDone);
+  BlockRead(FFile, FBuffer[FBufferPos], FBufferSize-FBufferPos, lRead);
+  Inc(FBufferPos, lRead);
+  if lRead = 0 then
+  begin
+    { EOF reached }
+    Close(FFile);
+    exit(wsDone);
+  end;
+  Result := wsPendingData;
+end;
+
+constructor TCGIOutput.Create(ASocket: TLHTTPSocket);
+begin
+  inherited;
+end;
+
+destructor TCGIOutput.Destroy;
+begin
+  inherited;
+end;
+
+procedure TCGIOutput.AddHTTPParam(const AName: string; AParam: TLHTTPParameter);
+var
+  lValue: pchar;
+begin
+  lValue := FSocket.Parameters[AParam];
+  if lValue = nil then exit;
+  AddEnvironment(AName, lValue);
+end;
+
+procedure TCGIOutput.StartRequest;
+var
+  lServerSocket: TLHTTPServerSocket absolute FSocket;
+  tempStr: string;
+begin
+{
+  FProcess.Environment.Add('SERVER_ADDR=');
+  FProcess.Environment.Add('SERVER_ADMIN=');
+  FProcess.Environment.Add('SERVER_NAME=');
+  FProcess.Environment.Add('SERVER_PORT=');
+}
+  tempStr := TLHTTPServer(lServerSocket.Creator).ServerSoftware;
+  if Length(tempStr) > 0 then
+    AddEnvironment('SERVER_SOFTWARE', tempStr);
+
+  AddEnvironment('GATEWAY_INTERFACE', 'CGI/1.1'); 
+  AddEnvironment('SERVER_PROTOCOL', lServerSocket.RequestInfo.VersionStr);
+  AddEnvironment('REQUEST_METHOD', lServerSocket.RequestInfo.Method);
+  AddEnvironment('REQUEST_URI', '/'+lServerSocket.RequestInfo.Argument);
+
+  if Length(FExtraPath) > 0 then
+  begin
+    AddEnvironment('PATH_INFO', FExtraPath);
+    { do not set PATH_TRANSLATED: bug in PHP }
+//    AddEnvironment('PATH_TRANSLATED', FDocumentRoot+FExtraPath);
+  end;
+
+  AddEnvironment('SCRIPT_NAME', FScriptName);
+  AddEnvironment('SCRIPT_FILENAME', FScriptFileName);
+  
+  AddEnvironment('QUERY_STRING', lServerSocket.RequestInfo.QueryParams);
+  AddHTTPParam('CONTENT_TYPE', hpContentType);
+  AddHTTPParam('CONTENT_LENGTH', hpContentLength);
+
+  AddEnvironment('REMOTE_ADDR', FSocket.PeerAddress);
+  AddEnvironment('REMOTE_PORT', IntToStr(FSocket.LocalPort));
+
+  { used when user has authenticated in some way to server }
+//  AddEnvironment('AUTH_TYPE='+...);
+//  AddEnvironment('REMOTE_USER='+...);
+  
+  AddEnvironment('DOCUMENT_ROOT', FDocumentRoot);
+  AddEnvironment('REDIRECT_STATUS', '200');
+  AddHTTPParam('HTTP_HOST', hpHost);
+  AddHTTPParam('HTTP_COOKIE', hpCookie);
+  AddHTTPParam('HTTP_CONNECTION', hpConnection);
+  AddHTTPParam('HTTP_REFERER', hpReferer);
+  AddHTTPParam('HTTP_USER_AGENT', hpUserAgent);
+  AddHTTPParam('HTTP_ACCEPT', hpAccept);
+  AddEnvironment('PATH', FEnvPath);
+
+  FParsingHeaders := true;
+  FReadPos := FBufferPos;
+  FParsePos := FBuffer+FReadPos;
+end;
+
+function  TCGIOutput.ParseHeaders: boolean;
+var
+  lHttpStatus: TLHTTPStatus;
+  iEnd, lCode: integer;
+  lStatus, lLength: dword;
+  pLineEnd, pNextLine, pValue: pchar;
+  lServerSocket: TLHTTPServerSocket absolute FSocket;
+
+  procedure AddExtraHeader;
+  begin
+    AppendString(lServerSocket.HeaderOut.ExtraHeaders, FParsePos + ': ' + pValue + #13#10);
+  end;
+
+begin
+  repeat
+    iEnd := IndexByte(FParsePos^, @FBuffer[FReadPos]-FParsePos, 10);
+    if iEnd = -1 then exit(false);
+    pNextLine := FParsePos+iEnd+1;
+    if (iEnd > 0) and (FParsePos[iEnd-1] = #13) then
+      dec(iEnd);
+    pLineEnd := FParsePos+iEnd;
+    pLineEnd^ := #0;
+    if pLineEnd = FParsePos then
+    begin
+      { empty line signals end of headers }
+      FParsingHeaders := false;
+      FBufferOffset := pNextLine-FBuffer;
+      FBufferPos := FReadPos;
+      FReadPos := 0;
+      lServerSocket.StartResponse(Self, true);
+      exit(false);
+    end;
+    iEnd := IndexByte(FParsePos^, iEnd, ord(':'));
+    if (iEnd = -1) or (FParsePos[iEnd+1] <> ' ') then
+      break;
+    FParsePos[iEnd] := #0;
+    pValue := FParsePos+iEnd+2;
+    if StrIComp(FParsePos, 'Content-type') = 0 then
+    begin
+      lServerSocket.ResponseInfo.ContentType := pValue;
+    end else 
+    if StrIComp(FParsePos, 'Location') = 0 then
+    begin
+      if StrLIComp(pValue, 'http://', 7) = 0 then
+      begin
+        lServerSocket.ResponseInfo.Status := hsMovedPermanently;
+        { add location header as-is to response }
+        AddExtraHeader;
+      end else
+        InternalWrite('WARNING: unimplemented ''Location'' response received from CGI script');
+    end else 
+    if StrIComp(FParsePos, 'Status') = 0 then
+    begin
+      { sometimes we get '<status code> space <reason>' }
+      iEnd := IndexByte(pValue^, pLineEnd-pValue, ord(' '));
+      if iEnd <> -1 then
+        pValue[iEnd] := #0;
+      Val(pValue, lStatus, lCode);
+      if lCode <> 0 then
+        break;
+      for lHttpStatus := Low(TLHTTPStatus) to High(TLHTTPStatus) do
+        if HTTPStatusCodes[lHttpStatus] = lStatus then
+          lServerSocket.ResponseInfo.Status := lHttpStatus;
+    end else
+    if StrIComp(FParsePos, 'Content-Length') = 0 then
+    begin
+      Val(pValue, lLength, lCode);
+      if lCode <> 0 then
+        break;
+      lServerSocket.HeaderOut.ContentLength := lLength;
+    end else
+    if StrIComp(FParsePos, 'Last-Modified') = 0 then
+    begin
+      if not TryHTTPDateStrToDateTime(pValue, 
+          lServerSocket.ResponseInfo.LastModified) then
+        InternalWrite('WARNING: unable to parse last-modified string from CGI script: ' + pValue);
+    end else
+      AddExtraHeader;
+    FParsePos := pNextLine;
+  until false;
+
+  { error happened }
+  lServerSocket.ResponseInfo.Status := hsInternalError;
+  exit(true);
+end;
+
+function TCGIOutput.FillBuffer: TWriteBlockStatus;
+begin
+  if not FParsingHeaders then
+    FReadPos := FBufferPos;
+  Result := WriteCGIData;
+  if FParsingHeaders then
+  begin
+    if ParseHeaders then
+    begin
+      { error while parsing }
+      FEof := true;
+      exit(wsDone);
+    end;
+  end else
+    FBufferPos := FReadPos;
+end;
+
+procedure TCGIOutput.WriteCGIBlock;
+begin
+  { CGI process has output pending, we can write a block to socket }
+  if FParsingHeaders then
+  begin
+    if (FillBuffer = wsDone) and FParsingHeaders then
+    begin
+      { still parsing headers ? something's wrong }
+      FParsingHeaders := false;
+      CGIOutputError;
+      TLHTTPServerSocket(FSocket).StartResponse(Self);
+    end;
+  end;
+  if not FParsingHeaders then
+    FSocket.WriteBlock;
+end;
+
+{ TSimpleCGIOutput }
+
+constructor TSimpleCGIOutput.Create(ASocket: TLHTTPSocket);
+begin
+  inherited;
+  FProcess := TLProcess.Create(nil);
+  FProcess.Options := FProcess.Options + [poUsePipes];
+  FProcess.OnNeedInput := @CGIProcNeedInput;
+  FProcess.OnHasOutput := @CGIProcHasOutput;
+  FProcess.OnHasStderr := @CGIProcHasStderr;
+end;
+
+destructor TSimpleCGIOutput.Destroy;
+begin
+  inherited;
+  FProcess.Free;
+end;
+
+function TSimpleCGIOutput.WriteCGIData: TWriteBlockStatus;
+var
+  lRead: integer;
+begin
+  lRead := FProcess.Output.Read(FBuffer[FReadPos], FBufferSize-FReadPos);
+  if lRead = 0 then exit(wsDone);
+  Inc(FReadPos, lRead);
+  Result := InputBufferEmptyToWriteStatus[lRead = 0];
+end;
+
+procedure TSimpleCGIOutput.AddEnvironment(const AName, AValue: string);
+begin
+  FProcess.Environment.Add(AName+'='+AValue);
+end;
+
+procedure TSimpleCGIOutput.DoneInput;
+begin
+  FProcess.CloseInput;
+end;
+
+function TSimpleCGIOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
+begin
+  if ASize > 0 then
+    Result := FProcess.Input.Write(ABuffer^, ASize)
+  else
+    Result := 0;
+  FProcess.InputEvent.IgnoreWrite := ASize = 0;
+end;
+
+procedure TSimpleCGIOutput.StartRequest;
+begin
+  inherited;
+  
+  FProcess.Eventer := FSocket.Eventer;
+  FProcess.Execute;
+end;
+
+procedure TSimpleCGIOutput.CGIOutputError;
+var
+  ServerSocket: TLHTTPServerSocket absolute FSocket;
+begin
+  if FProcess.ExitStatus = 127 then
+    ServerSocket.ResponseInfo.Status := hsNotFound
+  else
+    ServerSocket.ResponseInfo.Status := hsInternalError;
+end;
+
+procedure TSimpleCGIOutput.CGIProcNeedInput(AHandle: TLHandle);
+begin
+  FProcess.InputEvent.IgnoreWrite := true;
+  FSocket.ParseBuffer;
+end;
+
+procedure TSimpleCGIOutput.CGIProcHasOutput(AHandle: TLHandle);
+begin
+  WriteCGIBlock;
+end;
+
+procedure TSimpleCGIOutput.CGIProcHasStderr(AHandle: TLHandle);
+var
+  lBuf: array[0..1023] of char;
+  lRead: integer;
+begin
+  lRead := FProcess.Stderr.Read(lBuf, sizeof(lBuf)-1);
+  lBuf[lRead] := #0;
+  write(pchar(@lBuf[0]));
+end;
+
+{ TFastCGIOutput }
+
+constructor TFastCGIOutput.Create(ASocket: TLHTTPSocket);
+begin
+  inherited;
+end;
+
+destructor TFastCGIOutput.Destroy;
+begin
+  if FRequest <> nil then
+  begin
+    FRequest.OnInput := nil;
+    FRequest.OnOutput := nil;
+    FRequest.OnStderr := nil;
+    FRequest.OnEndRequest := nil;
+    FRequest.AbortRequest;
+  end;
+  inherited;
+end;
+
+procedure TFastCGIOutput.AddEnvironment(const AName, AValue: string);
+begin
+  FRequest.SendParam(AName, AValue);
+end;
+
+procedure TFastCGIOutput.CGIOutputError;
+begin
+  TLHTTPServerSocket(FSocket).ResponseInfo.Status := hsInternalError;
+end;
+
+procedure TFastCGIOutput.DoneInput;
+begin
+  if FRequest <> nil then
+    FRequest.DoneInput;
+end;
+
+procedure TFastCGIOutput.RequestEnd(ARequest: TLFastCGIRequest);
+begin
+  FRequest.OnEndRequest := nil;
+  FRequest.OnInput := nil;
+  FRequest.OnOutput := nil;
+  FRequest := nil;
+  { trigger final write, to flush output to socket }
+  WriteCGIBlock;
+end;
+
+procedure TFastCGIOutput.RequestNeedInput(ARequest: TLFastCGIRequest);
+begin
+  FSocket.ParseBuffer;
+end;
+
+procedure TFastCGIOutput.RequestHasOutput(ARequest: TLFastCGIRequest);
+begin
+  WriteCGIBlock;
+end;
+
+procedure TFastCGIOutput.RequestHasStderr(ARequest: TLFastCGIRequest);
+var
+  lBuf: array[0..1023] of char;
+  lRead: integer;
+begin
+  lRead := ARequest.Get(lBuf, sizeof(lBuf)-1);
+  lBuf[lRead] := #0;
+  write(pchar(@lBuf[0]));
+end;
+
+function  TFastCGIOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
+begin
+  Result := FRequest.SendInput(ABuffer, ASize);
+end;
+
+function  TFastCGIOutput.WriteCGIData: TWriteBlockStatus;
+var
+  lRead: integer;
+begin
+  if FRequest = nil then exit(wsDone);
+  if FRequest.OutputDone then exit(wsDone);
+  lRead := FRequest.Get(@FBuffer[FReadPos], FBufferSize-FReadPos);
+  Inc(FReadPos, lRead);
+  Result := InputBufferEmptyToWriteStatus[lRead = 0];
+end;
+
+function  TFastCGIOutput.WriteBlock: TWriteBlockStatus;
+begin
+  if (FRequest <> nil) and FRequest.OutputPending then
+  begin
+    FRequest.ParseClientBuffer;
+    Result := wsWaitingData;
+  end else
+    Result := inherited;
+end;
+
+procedure TFastCGIOutput.StartRequest;
+begin
+  FRequest.OnEndRequest := @RequestEnd;
+  FRequest.OnInput := @RequestNeedInput;
+  FRequest.OnOutput := @RequestHasOutput;
+  FRequest.OnStderr := @RequestHasStderr;
+  inherited;
+  FRequest.DoneParams;
+end;
+
+{ TFormOutput } 
+
+constructor TFormOutput.Create(ASocket: TLHTTPSocket);
+begin
+  inherited;
+  FRequestVars := TStringList.Create;
+end;
+
+destructor TFormOutput.Destroy;
+var
+  I: integer;
+  tmpObj: TObject;
+begin
+  for I := 0 to FRequestVars.Count - 1 do
+  begin
+    tmpObj := FRequestVars.Objects[I];
+    Finalize(string(tmpObj));
+    FRequestVars.Objects[I] := nil;
+  end;
+  FRequestVars.Free;
+  inherited;
+end;
+
+function TFormOutput.AddVariables(Variables: pchar; ASize: integer; SepChar: char): integer;
+var
+  varname, sep, next: pchar;
+  strName, strValue: string;
+  tmpObj: TObject;
+  i: integer;
+begin
+  if Variables = nil then
+    exit(0);
+  if ASize = -1 then
+    ASize := StrLen(Variables);
+  varname := Variables;
+  repeat
+    sep := varname + IndexChar(varname^, ASize, '=');
+    if sep < varname then
+      break;
+    dec(ASize, sep-varname);
+    next := sep + IndexChar(sep^, ASize, SepChar);
+    if next < sep then
+    begin
+      next := sep + ASize;
+      ASize := 0;
+    end else
+      dec(ASize, next+1-sep);
+    if sep > varname then
+    begin
+      setlength(strName, sep-varname);
+      move(varname[0], strName[1], sep-varname);
+      setlength(strValue, next-sep-1);
+      move(sep[1], strValue[1], next-sep-1);
+      i := FRequestVars.Add(strName);
+      tmpObj := nil;
+      string(tmpObj) := strValue;
+      FRequestVars.Objects[i] := tmpObj; 
+    end;
+    varname := next+1;
+  until false;
+  Result := ASize;
+end;
+
+procedure TFormOutput.DoneInput;
+begin
+  if Assigned(FOnExtraHeaders) then
+    FOnExtraHeaders(Self);
+  TLHTTPServerSocket(FSocket).StartResponse(Self);
+end;
+
+function TFormOutput.HandleInputFormURL(ABuffer: pchar; ASize: integer): integer;
+begin
+  Result := ASize-AddVariables(ABuffer, ASize, URIParamSepChar)
+end;
+
+procedure TFormOutput.ParseMultipartHeader(ABuffer, ALineEnd: pchar);
+var
+  I: TLMultipartParameter;
+  len: integer;
+begin
+  for I := Low(TLMultipartParameter) to High(TLMultipartParameter) do
+  begin
+    len := Length(MPParameterStrings[I]);
+    if ABuffer+len >= ALineEnd then
+      continue;
+    if (ABuffer[len] = ':')
+      and (StrLIComp(ABuffer, PChar(MPParameterStrings[I]), len) = 0) then
+    begin
+      Inc(ABuffer, len+2);
+      repeat
+        if ABuffer = ALineEnd then exit;
+        if ABuffer^ <> ' ' then break;
+        inc(ABuffer);
+      until false;
+      FMPParameters[I] := ABuffer;
+      if I = mpContentType then
+      begin
+        repeat
+          if ABuffer = ALineEnd then exit;
+          if ABuffer = ';' then break;
+          inc(ABuffer);
+        until false;
+
+      end;
+      break;
+    end;
+  end;
+end;
+
+function TFormOutput.FindBoundary(ABuffer: pchar): pchar;
+begin
+  {$warning TODO}
+  Result := nil;
+end;
+
+function TFormOutput.HandleInputMultipart(ABuffer: pchar; ASize: integer): integer;
+var
+  pos, next, endline: pchar;
+begin
+  pos := ABuffer;
+  repeat
+    case FMPState of
+      msStart:
+      begin
+        { discard until first boundary }
+        next := FindBoundary(pos);
+        if next = nil then
+          exit(ASize);
+        FMPState := msBodypartHeader;
+      end;
+      msBodypartHeader:
+      begin
+        endline := pos + IndexChar(pos, ASize, #10);
+        if endline < pos then
+          exit(pos-ABuffer);
+        next := endline+1;
+        if (endline > pos) and ((endline-1)^ = #13) then
+          dec(endline);
+        endline^ := #0;
+        if endline > pos then
+          ParseMultipartHeader(pos, endline)
+        else
+          FMPState := msBodypartData;
+      end;
+      msBodypartData:
+      begin
+        { decode based on content-transfer-encoding ? }
+        { CRLF before boundary, belongs to boundary, not data! }
+        next := FindBoundary(ABuffer);
+      end;
+    else
+      exit(ASize);
+    end;
+    dec(ASize, next-pos);
+    pos := next;
+  until false;
+end;
+
+function TFormOutput.HandleInputDiscard(ABuffer: pchar; ASize: integer): integer;
+begin
+  Result := ASize;
+end;
+
+function TFormOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
+begin
+  Result := FHandleInput(ABuffer, ASize);
+end;
+
+function TFormOutput.FillBuffer: TWriteBlockStatus;
+begin
+  Result := wsDone;
+  if Assigned(FOnFillBuffer) then
+    FOnFillBuffer(Self, Result);
+end;
+
+procedure TFormOutput.DeleteCookie(const AName: string; const APath: string = '/'; 
+  const ADomain: string = '');
+begin
+  { cookies expire when expires is in the past, duh }
+  SetCookie(AName, '', Now - 7.0, APath, ADomain);
+end;
+
+procedure TFormOutput.SetCookie(const AName, AValue: string; const AExpires: TDateTime;
+  const APath: string = '/'; const ADomain: string = '');
+var
+  headers: PStringBuffer;
+begin
+  headers := @TLHTTPServerSocket(FSocket).HeaderOut.ExtraHeaders;
+  AppendString(headers^, 'Set-Cookie: ' + HTTPEncode(AName) + '=' + HTTPEncode(AValue));
+  AppendString(headers^, ';path=' + APath + ';expires=' + FormatDateTime(HTTPDateFormat, AExpires));
+  if Length(ADomain) > 0 then
+  begin
+    AppendString(headers^, ';domain=');
+    AppendString(headers^, ADomain);
+  end;
+  AppendString(headers^, #13#10);
+end;
+
+{ TFormHandler }
+
+procedure TFormHandler.SelectMultipart(AFormOutput: TFormOutput; AContentType: pchar);
+var
+  boundary, endquote: pchar;
+begin
+  boundary := StrScan(AContentType, '=');
+  if boundary <> nil then
+  begin
+    Inc(boundary);
+    if boundary^ = '"' then
+    begin
+      Inc(boundary);
+      endquote := StrScan(boundary, '"');
+      if endquote <> nil then
+        endquote^ := #0;
+    end;
+  end;
+
+  AFormOutput.FBoundary := boundary;
+  AFormOutput.FHandleInput := @AFormOutput.HandleInputMultipart;
+end;
+
+function TFormHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
+var
+  newFormOutput: TFormOutput;
+  contentType: pchar;
+begin
+  if not Assigned(FOnHandleURI) then
+    exit(nil);
+
+  newFormOutput := FOnHandleURI(ASocket);
+  if newFormOutput = nil then
+    exit(nil);
+
+  newFormOutput.AddVariables(ASocket.RequestInfo.QueryParams, -1, URIParamSepChar);
+  newFormOutput.AddVariables(ASocket.Parameters[hpCookie], -1, CookieSepChar);
+  contentType := TLHTTPServerSocket(ASocket).Parameters[hpContentType];
+  if StrIComp(contentType, FormURLContentType) = 0 then
+    newFormOutput.FHandleInput := @newFormOutput.HandleInputFormURL
+  else if StrIComp(contentType, MultipartContentType) = 0 then
+    SelectMultipart(newFormOutput, contentType)
+  else
+    newFormOutput.FHandleInput := @newFormOutput.HandleInputDiscard;
+
+  Result := newFormOutput;
+end;
+
+end.

utils/fppkg/lnet/openssl.pp

@@ -0,0 +1,1452 @@
+unit OpenSSL;
+
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.004.001 |
+|==============================================================================|
+| Content: SSL support by OpenSSL                                              |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2002-2005.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| FreePascal basic cleanup (original worked too): Ales Katona                  |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{
+Special thanks to Gregor Ibic <[email protected]>
+ (Intelicom d.o.o., http://www.intelicom.si)
+ for good inspiration about begin with SSL programming.
+}
+
+{$MODE DELPHI}{$H+}
+
+{:@abstract(OpenSSL support)
+
+This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit).
+OpenSSL is loaded dynamicly on-demand. If this library is not found in system,
+requested OpenSSL function just return errorcode.
+}
+
+interface
+
+uses
+  DynLibs;
+
+var
+  {$IFDEF WINDOWS}
+  DLLSSLName: string = 'ssleay32.dll';
+  DLLSSLName2: string = 'libssl32.dll';
+  DLLUtilName: string = 'libeay32.dll';
+  {$ELSE}
+  DLLSSLName: string = 'libssl.so';
+  DLLUtilName: string = 'libcrypto.so';
+  {$ENDIF}
+
+type
+  SslPtr = Pointer;
+  PSslPtr = ^SslPtr;
+  PSSL_CTX = SslPtr;
+  PSSL = SslPtr;
+  PSSL_METHOD = SslPtr;
+  PX509 = SslPtr;
+  PX509_NAME = SslPtr;
+  PEVP_MD	= SslPtr;
+  PInteger = ^Integer;
+  PBIO_METHOD = SslPtr;
+  PBIO = SslPtr;
+  EVP_PKEY = SslPtr;
+  PRSA = SslPtr;
+  PASN1_UTCTIME = SslPtr;
+  PASN1_INTEGER = SslPtr;
+  PPasswdCb = SslPtr;
+  PFunction = procedure;
+
+  DES_cblock = array[0..7] of Byte;
+  PDES_cblock = ^DES_cblock;
+  des_ks_struct = packed record
+    ks: DES_cblock;
+    weak_key: Integer;
+  end;
+  des_key_schedule = array[1..16] of des_ks_struct;
+
+const
+  EVP_MAX_MD_SIZE = 16 + 20;
+
+  SSL_ERROR_NONE = 0;
+  SSL_ERROR_SSL = 1;
+  SSL_ERROR_WANT_READ = 2;
+  SSL_ERROR_WANT_WRITE = 3;
+  SSL_ERROR_WANT_X509_LOOKUP = 4;
+  SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno
+  SSL_ERROR_ZERO_RETURN = 6;
+  SSL_ERROR_WANT_CONNECT = 7;
+  SSL_ERROR_WANT_ACCEPT = 8;
+
+  SSL_OP_NO_SSLv2 = $01000000;
+  SSL_OP_NO_SSLv3 = $02000000;
+  SSL_OP_NO_TLSv1 = $04000000;
+  SSL_OP_ALL = $000FFFFF;
+  SSL_VERIFY_NONE = $00;
+  SSL_VERIFY_PEER = $01;
+
+  OPENSSL_DES_DECRYPT = 0;
+  OPENSSL_DES_ENCRYPT = 1;
+
+  X509_V_OK =	0;
+  X509_V_ILLEGAL = 1;
+  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
+  X509_V_ERR_UNABLE_TO_GET_CRL = 3;
+  X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
+  X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
+  X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
+  X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
+  X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
+  X509_V_ERR_CERT_NOT_YET_VALID = 9;
+  X509_V_ERR_CERT_HAS_EXPIRED = 10;
+  X509_V_ERR_CRL_NOT_YET_VALID = 11;
+  X509_V_ERR_CRL_HAS_EXPIRED = 12;
+  X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
+  X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
+  X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
+  X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
+  X509_V_ERR_OUT_OF_MEM = 17;
+  X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
+  X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
+  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
+  X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
+  X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
+  X509_V_ERR_CERT_REVOKED = 23;
+  X509_V_ERR_INVALID_CA = 24;
+  X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
+  X509_V_ERR_INVALID_PURPOSE = 26;
+  X509_V_ERR_CERT_UNTRUSTED = 27;
+  X509_V_ERR_CERT_REJECTED = 28;
+  //These are 'informational' when looking for issuer cert
+  X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
+  X509_V_ERR_AKID_SKID_MISMATCH = 30;
+  X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
+  X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
+  X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
+  X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
+  //The application is not happy
+  X509_V_ERR_APPLICATION_VERIFICATION = 50;
+
+  SSL_FILETYPE_ASN1	= 2;
+  SSL_FILETYPE_PEM = 1;
+  EVP_PKEY_RSA = 6;
+
+var
+  SSLLibHandle: TLibHandle = 0;
+  SSLUtilHandle: TLibHandle = 0;
+  SSLLibFile: string = '';
+  SSLUtilFile: string = '';
+
+// libssl.dll
+  function SslGetError(s: PSSL; ret_code: Integer):Integer;
+  function SslLibraryInit:Integer;
+  procedure SslLoadErrorStrings;
+//  function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+  function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):Integer;
+  function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+  procedure SslCtxFree(arg0: PSSL_CTX);
+  function SslSetFd(s: PSSL; fd: Integer):Integer;
+  function SslMethodV2:PSSL_METHOD;
+  function SslMethodV3:PSSL_METHOD;
+  function SslMethodTLSV1:PSSL_METHOD;
+  function SslMethodV23:PSSL_METHOD;
+  function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+  function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;
+//  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+  function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer;
+  function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+//  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;
+  function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+  procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+  procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+//  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):Integer;
+  function SslNew(ctx: PSSL_CTX):PSSL;
+  procedure SslFree(ssl: PSSL);
+  function SslAccept(ssl: PSSL):Integer;
+  function SslConnect(ssl: PSSL):Integer;
+  function SslShutdown(ssl: PSSL):Integer;
+  function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslPending(ssl: PSSL):Integer;
+  function SslGetVersion(ssl: PSSL):String;
+  function SslGetPeerCertificate(ssl: PSSL):PX509;
+  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+  function SSLGetCurrentCipher(s: PSSL):SslPtr;
+  function SSLCipherGetName(c: SslPtr): String;
+  function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+  function SSLGetVerifyResult(ssl: PSSL):Integer;
+
+// libeay.dll
+  function X509New: PX509;
+  procedure X509Free(x: PX509);
+  function X509NameOneline(a: PX509_NAME; var buf: String; size: Integer):String;
+  function X509GetSubjectName(a: PX509):PX509_NAME;
+  function X509GetIssuerName(a: PX509):PX509_NAME;
+  function X509NameHash(x: PX509_NAME):Cardinal;
+//  function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+  function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: Integer):Integer;
+  function X509print(b: PBIO; a: PX509): integer;
+  function X509SetVersion(x: PX509; version: integer): integer;
+  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+  function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+  function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
+    bytes: string; len, loc, _set: integer): integer;
+  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+  function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+  function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+  function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+  function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+  function EvpPkeyNew: EVP_PKEY;
+  procedure EvpPkeyFree(pk: EVP_PKEY);
+  function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+  function EvpGetDigestByName(Name: String): PEVP_MD;
+  procedure EVPcleanup;
+//  function ErrErrorString(e: integer; buf: PChar): PChar;
+  function SSLeayversion(t: integer): string;
+  procedure ErrErrorString(e: integer; var buf: string; len: integer);
+  function ErrGetError: integer;
+  procedure ErrClearError;
+  procedure ErrFreeStrings;
+  procedure ErrRemoveState(pid: integer);
+  procedure OPENSSLaddallalgorithms;
+  procedure CRYPTOcleanupAllExData;
+  procedure RandScreen;
+  function BioNew(b: PBIO_METHOD): PBIO;
+  procedure BioFreeAll(b: PBIO);
+  function BioSMem: PBIO_METHOD;
+  function BioCtrlPending(b: PBIO): integer;
+  function BioRead(b: PBIO; var Buf: String; Len: integer): integer;
+  function BioWrite(b: PBIO; Buf: String; Len: integer): integer;
+  function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+  function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer;
+  procedure PKCS12free(p12: SslPtr);
+  function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+  function Asn1UtctimeNew: PASN1_UTCTIME;
+  procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+  function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+  function i2dX509bio(b: PBIO; x: PX509): integer;
+  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+
+  // 3DES functions
+  procedure DESsetoddparity(Key: des_cblock);
+  function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+  procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+
+function IsSSLloaded: Boolean;
+function InitSSLInterface: Boolean;
+function DestroySSLInterface: Boolean;
+
+implementation
+
+type
+// libssl.dll
+  TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl;
+  TSslLibraryInit = function:Integer; cdecl;
+  TSslLoadErrorStrings = procedure; cdecl;
+  TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PChar):Integer; cdecl;
+  TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl;
+  TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl;
+  TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl;
+  TSslMethodV2 = function:PSSL_METHOD; cdecl;
+  TSslMethodV3 = function:PSSL_METHOD; cdecl;
+  TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
+  TSslMethodV23 = function:PSSL_METHOD; cdecl;
+  TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl;
+  TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl;
+  TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; cdecl;
+  TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl;
+  TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl;
+  TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; cdecl;
+  TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PChar):Integer; cdecl;
+  TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl;
+  TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl;
+  TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl;
+  TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer; cdecl;
+  TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl;
+  TSslFree = procedure(ssl: PSSL); cdecl;
+  TSslAccept = function(ssl: PSSL):Integer; cdecl;
+  TSslConnect = function(ssl: PSSL):Integer; cdecl;
+  TSslShutdown = function(ssl: PSSL):Integer; cdecl;
+  TSslRead = function(ssl: PSSL; buf: PChar; num: Integer):Integer; cdecl;
+  TSslPeek = function(ssl: PSSL; buf: PChar; num: Integer):Integer; cdecl;
+  TSslWrite = function(ssl: PSSL; const buf: PChar; num: Integer):Integer; cdecl;
+  TSslPending = function(ssl: PSSL):Integer; cdecl;
+  TSslGetVersion = function(ssl: PSSL):PChar; cdecl;
+  TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl;
+  TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl;
+  TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl;
+  TSSLCipherGetName = function(c: Sslptr):PChar; cdecl;
+  TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
+  TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
+
+// libeay.dll
+  TX509New = function: PX509; cdecl;
+  TX509Free = procedure(x: PX509); cdecl;
+  TX509NameOneline = function(a: PX509_NAME; buf: PChar; size: Integer):PChar; cdecl;
+  TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
+  TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
+  TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl;
+  TX509Digest = function(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer; cdecl;
+  TX509print = function(b: PBIO; a: PX509): integer; cdecl;
+  TX509SetVersion = function(x: PX509; version: integer): integer; cdecl;
+  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl;
+  TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl;
+  TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PChar; _type: integer;
+    bytes: PChar; len, loc, _set: integer): integer; cdecl;
+  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl;
+  TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl;
+  TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+  TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+  TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl;
+  TEvpPkeyNew = function: EVP_PKEY; cdecl;
+  TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
+  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl;
+  TEvpGetDigestByName = function(Name: PChar): PEVP_MD; cdecl;
+  TEVPcleanup = procedure; cdecl;
+  TSSLeayversion = function(t: integer): PChar; cdecl;
+  TErrErrorString = procedure(e: integer; buf: PChar; len: integer); cdecl;
+  TErrGetError = function: integer; cdecl;
+  TErrClearError = procedure; cdecl;
+  TErrFreeStrings = procedure; cdecl;
+  TErrRemoveState = procedure(pid: integer); cdecl;
+  TOPENSSLaddallalgorithms = procedure; cdecl;
+  TCRYPTOcleanupAllExData = procedure; cdecl;
+  TRandScreen = procedure; cdecl;
+  TBioNew = function(b: PBIO_METHOD): PBIO; cdecl;
+  TBioFreeAll = procedure(b: PBIO); cdecl;
+  TBioSMem = function: PBIO_METHOD; cdecl;
+  TBioCtrlPending = function(b: PBIO): integer; cdecl;
+  TBioRead = function(b: PBIO; Buf: PChar; Len: integer): integer; cdecl;
+  TBioWrite = function(b: PBIO; Buf: PChar; Len: integer): integer; cdecl;
+  Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
+  TPKCS12parse = function(p12: SslPtr; pass: PChar; var pkey, cert, ca: SslPtr): integer; cdecl;
+  TPKCS12free = procedure(p12: SslPtr); cdecl;
+  TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
+  TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
+  TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
+  TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
+  Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
+  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
+
+  // 3DES functions
+  TDESsetoddparity = procedure(Key: des_cblock); cdecl;
+  TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl;
+  TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl;
+  //thread lock functions
+  TCRYPTOnumlocks = function: integer; cdecl;
+  TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl;
+
+var
+// libssl.dll
+  _SslGetError: TSslGetError = nil;
+  _SslLibraryInit: TSslLibraryInit = nil;
+  _SslLoadErrorStrings: TSslLoadErrorStrings = nil;
+  _SslCtxSetCipherList: TSslCtxSetCipherList = nil;
+  _SslCtxNew: TSslCtxNew = nil;
+  _SslCtxFree: TSslCtxFree = nil;
+  _SslSetFd: TSslSetFd = nil;
+  _SslMethodV2: TSslMethodV2 = nil;
+  _SslMethodV3: TSslMethodV3 = nil;
+  _SslMethodTLSV1: TSslMethodTLSV1 = nil;
+  _SslMethodV23: TSslMethodV23 = nil;
+  _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil;
+  _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil;
+  _SslCtxUsePrivateKeyFile: TSslCtxUsePrivateKeyFile = nil;
+  _SslCtxUseCertificate: TSslCtxUseCertificate = nil;
+  _SslCtxUseCertificateASN1: TSslCtxUseCertificateASN1 = nil;
+  _SslCtxUseCertificateFile: TSslCtxUseCertificateFile = nil;
+  _SslCtxUseCertificateChainFile: TSslCtxUseCertificateChainFile = nil;
+  _SslCtxCheckPrivateKeyFile: TSslCtxCheckPrivateKeyFile = nil;
+  _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil;
+  _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil;
+  _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil;
+  _SslNew: TSslNew = nil;
+  _SslFree: TSslFree = nil;
+  _SslAccept: TSslAccept = nil;
+  _SslConnect: TSslConnect = nil;
+  _SslShutdown: TSslShutdown = nil;
+  _SslRead: TSslRead = nil;
+  _SslPeek: TSslPeek = nil;
+  _SslWrite: TSslWrite = nil;
+  _SslPending: TSslPending = nil;
+  _SslGetVersion: TSslGetVersion = nil;
+  _SslGetPeerCertificate: TSslGetPeerCertificate = nil;
+  _SslCtxSetVerify: TSslCtxSetVerify = nil;
+  _SSLGetCurrentCipher: TSSLGetCurrentCipher = nil;
+  _SSLCipherGetName: TSSLCipherGetName = nil;
+  _SSLCipherGetBits: TSSLCipherGetBits = nil;
+  _SSLGetVerifyResult: TSSLGetVerifyResult = nil;
+
+// libeay.dll
+  _X509New: TX509New = nil;
+  _X509Free: TX509Free = nil;
+  _X509NameOneline: TX509NameOneline = nil;
+  _X509GetSubjectName: TX509GetSubjectName = nil;
+  _X509GetIssuerName: TX509GetIssuerName = nil;
+  _X509NameHash: TX509NameHash = nil;
+  _X509Digest: TX509Digest = nil;
+  _X509print: TX509print = nil;
+  _X509SetVersion: TX509SetVersion = nil;
+  _X509SetPubkey: TX509SetPubkey = nil;
+  _X509SetIssuerName: TX509SetIssuerName = nil;
+  _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil;
+  _X509Sign: TX509Sign = nil;
+  _X509GmtimeAdj: TX509GmtimeAdj = nil;
+  _X509SetNotBefore: TX509SetNotBefore = nil;
+  _X509SetNotAfter: TX509SetNotAfter = nil;
+  _X509GetSerialNumber: TX509GetSerialNumber = nil;
+  _EvpPkeyNew: TEvpPkeyNew = nil;
+  _EvpPkeyFree: TEvpPkeyFree = nil;
+  _EvpPkeyAssign: TEvpPkeyAssign = nil;
+  _EvpGetDigestByName: TEvpGetDigestByName = nil;
+  _EVPcleanup: TEVPcleanup = nil;
+  _SSLeayversion: TSSLeayversion = nil;
+  _ErrErrorString: TErrErrorString = nil;
+  _ErrGetError: TErrGetError = nil;
+  _ErrClearError: TErrClearError = nil;
+  _ErrFreeStrings: TErrFreeStrings = nil;
+  _ErrRemoveState: TErrRemoveState = nil;
+  _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil;
+  _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil;
+  _RandScreen: TRandScreen = nil;
+  _BioNew: TBioNew = nil;
+  _BioFreeAll: TBioFreeAll = nil;
+  _BioSMem: TBioSMem = nil;
+  _BioCtrlPending: TBioCtrlPending = nil;
+  _BioRead: TBioRead = nil;
+  _BioWrite: TBioWrite = nil;
+  _d2iPKCS12bio: Td2iPKCS12bio = nil;
+  _PKCS12parse: TPKCS12parse = nil;
+  _PKCS12free: TPKCS12free = nil;
+  _RsaGenerateKey: TRsaGenerateKey = nil;
+  _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
+  _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
+  _Asn1IntegerSet: TAsn1IntegerSet = nil;
+  _i2dX509bio: Ti2dX509bio = nil;
+  _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
+
+  // 3DES functions
+  _DESsetoddparity: TDESsetoddparity = nil;
+  _DESsetkeychecked: TDESsetkeychecked = nil;
+  _DESecbencrypt: TDESecbencrypt = nil;
+  //thread lock functions
+  _CRYPTOnumlocks: TCRYPTOnumlocks = nil;
+  _CRYPTOSetLockingCallback: TCRYPTOSetLockingCallback = nil;
+
+var
+  SSLloaded: boolean = false;
+
+// libssl.dll
+function SslGetError(s: PSSL; ret_code: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslGetError) then
+    Result := _SslGetError(s, ret_code)
+  else
+    Result := SSL_ERROR_SSL;
+end;
+
+function SslLibraryInit:Integer;
+begin
+  if InitSSLInterface and Assigned(_SslLibraryInit) then
+    Result := _SslLibraryInit
+  else
+    Result := 1;
+end;
+
+procedure SslLoadErrorStrings;
+begin
+  if InitSSLInterface and Assigned(_SslLoadErrorStrings) then
+    _SslLoadErrorStrings;
+end;
+
+//function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetCipherList) then
+    Result := _SslCtxSetCipherList(arg0, PChar(str))
+  else
+    Result := 0;
+end;
+
+function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+begin
+  if InitSSLInterface and Assigned(_SslCtxNew) then
+    Result := _SslCtxNew(meth)
+  else
+    Result := nil;
+end;
+
+procedure SslCtxFree(arg0: PSSL_CTX);
+begin
+  if InitSSLInterface and Assigned(_SslCtxFree) then
+    _SslCtxFree(arg0);
+end;
+
+function SslSetFd(s: PSSL; fd: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslSetFd) then
+    Result := _SslSetFd(s, fd)
+  else
+    Result := 0;
+end;
+
+function SslMethodV2:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV2) then
+    Result := _SslMethodV2
+  else
+    Result := nil;
+end;
+
+function SslMethodV3:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV3) then
+    Result := _SslMethodV3
+  else
+    Result := nil;
+end;
+
+function SslMethodTLSV1:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodTLSV1) then
+    Result := _SslMethodTLSV1
+  else
+    Result := nil;
+end;
+
+function SslMethodV23:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV23) then
+    Result := _SslMethodV23
+  else
+    Result := nil;
+end;
+
+function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then
+    Result := _SslCtxUsePrivateKey(ctx, pkey)
+  else
+    Result := 0;
+end;
+
+function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
+    Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
+  else
+    Result := 0;
+end;
+
+//function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
+    Result := _SslCtxUsePrivateKeyFile(ctx, PChar(_file), _type)
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificate) then
+    Result := _SslCtxUseCertificate(ctx, x)
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
+    Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d))
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
+    Result := _SslCtxUseCertificateFile(ctx, PChar(_file), _type)
+  else
+    Result := 0;
+end;
+
+//function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then
+    Result := _SslCtxUseCertificateChainFile(ctx, PChar(_file))
+  else
+    Result := 0;
+end;
+
+function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then
+    Result := _SslCtxCheckPrivateKeyFile(ctx)
+  else
+    Result := 0;
+end;
+
+procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCb) then
+    _SslCtxSetDefaultPasswdCb(ctx, cb);
+end;
+
+procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCbUserdata) then
+    _SslCtxSetDefaultPasswdCbUserdata(ctx, u);
+end;
+
+//function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then
+    Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath))
+  else
+    Result := 0;
+end;
+
+function SslNew(ctx: PSSL_CTX):PSSL;
+begin
+  if InitSSLInterface and Assigned(_SslNew) then
+    Result := _SslNew(ctx)
+  else
+    Result := nil;
+end;
+
+procedure SslFree(ssl: PSSL);
+begin
+  if InitSSLInterface and Assigned(_SslFree) then
+    _SslFree(ssl);
+end;
+
+function SslAccept(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslAccept) then
+    Result := _SslAccept(ssl)
+  else
+    Result := -1;
+end;
+
+function SslConnect(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslConnect) then
+    Result := _SslConnect(ssl)
+  else
+    Result := -1;
+end;
+
+function SslShutdown(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslShutdown) then
+    Result := _SslShutdown(ssl)
+  else
+    Result := -1;
+end;
+
+//function SslRead(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslRead) then
+    Result := _SslRead(ssl, PChar(buf), num)
+  else
+    Result := -1;
+end;
+
+//function SslPeek(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslPeek) then
+    Result := _SslPeek(ssl, PChar(buf), num)
+  else
+    Result := -1;
+end;
+
+//function SslWrite(ssl: PSSL; const buf: PChar; num: Integer):Integer;
+function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslWrite) then
+    Result := _SslWrite(ssl, PChar(buf), num)
+  else
+    Result := -1;
+end;
+
+function SslPending(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslPending) then
+    Result := _SslPending(ssl)
+  else
+    Result := 0;
+end;
+
+//function SslGetVersion(ssl: PSSL):PChar;
+function SslGetVersion(ssl: PSSL):String;
+begin
+  if InitSSLInterface and Assigned(_SslGetVersion) then
+    Result := _SslGetVersion(ssl)
+  else
+    Result := '';
+end;
+
+function SslGetPeerCertificate(ssl: PSSL):PX509;
+begin
+  if InitSSLInterface and Assigned(_SslGetPeerCertificate) then
+    Result := _SslGetPeerCertificate(ssl)
+  else
+    Result := nil;
+end;
+
+//procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr);
+procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetVerify) then
+    _SslCtxSetVerify(ctx, mode, @arg2);
+end;
+
+function SSLGetCurrentCipher(s: PSSL):SslPtr;
+begin
+  if InitSSLInterface and Assigned(_SSLGetCurrentCipher) then
+{$IFDEF CIL}
+{$ELSE}
+    Result := _SSLGetCurrentCipher(s)
+{$ENDIF}
+  else
+    Result := nil;
+end;
+
+//function SSLCipherGetName(c: SslPtr):PChar;
+function SSLCipherGetName(c: SslPtr):String;
+begin
+  if InitSSLInterface and Assigned(_SSLCipherGetName) then
+    Result := _SSLCipherGetName(c)
+  else
+    Result := '';
+end;
+
+//function SSLCipherGetBits(c: SslPtr; alg_bits: PInteger):Integer;
+function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SSLCipherGetBits) then
+    Result := _SSLCipherGetBits(c, @alg_bits)
+  else
+    Result := 0;
+end;
+
+function SSLGetVerifyResult(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SSLGetVerifyResult) then
+    Result := _SSLGetVerifyResult(ssl)
+  else
+    Result := X509_V_ERR_APPLICATION_VERIFICATION;
+end;
+
+// libeay.dll
+function X509New: PX509;
+begin
+  if InitSSLInterface and Assigned(_X509New) then
+    Result := _X509New
+  else
+    Result := nil;
+end;
+
+procedure X509Free(x: PX509);
+begin
+  if InitSSLInterface and Assigned(_X509Free) then
+    _X509Free(x);
+end;
+
+//function SslX509NameOneline(a: PX509_NAME; buf: PChar; size: Integer):PChar;
+function X509NameOneline(a: PX509_NAME; var buf: String; size: Integer):String;
+begin
+  if InitSSLInterface and Assigned(_X509NameOneline) then
+    Result := _X509NameOneline(a, PChar(buf),size)
+  else
+    Result := '';
+end;
+
+function X509GetSubjectName(a: PX509):PX509_NAME;
+begin
+  if InitSSLInterface and Assigned(_X509GetSubjectName) then
+    Result := _X509GetSubjectName(a)
+  else
+    Result := nil;
+end;
+
+function X509GetIssuerName(a: PX509):PX509_NAME;
+begin
+  if InitSSLInterface and Assigned(_X509GetIssuerName) then
+    Result := _X509GetIssuerName(a)
+  else
+    Result := nil;
+end;
+
+function X509NameHash(x: PX509_NAME):Cardinal;
+begin
+  if InitSSLInterface and Assigned(_X509NameHash) then
+    Result := _X509NameHash(x)
+  else
+    Result := 0;
+end;
+
+//function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_X509Digest) then
+    Result := _X509Digest(data, _type, PChar(md), @len)
+  else
+    Result := 0;
+end;
+
+function EvpPkeyNew: EVP_PKEY;
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyNew) then
+    Result := _EvpPkeyNew
+  else
+    Result := nil;
+end;
+
+procedure EvpPkeyFree(pk: EVP_PKEY);
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyFree) then
+    _EvpPkeyFree(pk);
+end;
+
+function SSLeayversion(t: integer): string;
+begin
+  if InitSSLInterface and Assigned(_SSLeayversion) then
+    Result := PChar(_SSLeayversion(t))
+  else
+    Result := '';
+end;
+
+procedure ErrErrorString(e: integer; var buf: string; len: integer);
+begin
+  if InitSSLInterface and Assigned(_ErrErrorString) then
+    _ErrErrorString(e, Pointer(buf), len);
+  buf := PChar(Buf);
+end;
+
+function ErrGetError: integer;
+begin
+  if InitSSLInterface and Assigned(_ErrGetError) then
+    Result := _ErrGetError
+  else
+    Result := SSL_ERROR_SSL;
+end;
+
+procedure ErrClearError;
+begin
+  if InitSSLInterface and Assigned(_ErrClearError) then
+    _ErrClearError;
+end;
+
+procedure ErrFreeStrings;
+begin
+  if InitSSLInterface and Assigned(_ErrFreeStrings) then
+    _ErrFreeStrings;
+end;
+
+procedure ErrRemoveState(pid: integer);
+begin
+  if InitSSLInterface and Assigned(_ErrRemoveState) then
+    _ErrRemoveState(pid);
+end;
+
+procedure OPENSSLaddallalgorithms;
+begin
+  if InitSSLInterface and Assigned(_OPENSSLaddallalgorithms) then
+    _OPENSSLaddallalgorithms;
+end;
+
+procedure EVPcleanup;
+begin
+  if InitSSLInterface and Assigned(_EVPcleanup) then
+    _EVPcleanup;
+end;
+
+procedure CRYPTOcleanupAllExData;
+begin
+  if InitSSLInterface and Assigned(_CRYPTOcleanupAllExData) then
+    _CRYPTOcleanupAllExData;
+end;
+
+procedure RandScreen;
+begin
+  if InitSSLInterface and Assigned(_RandScreen) then
+    _RandScreen;
+end;
+
+function BioNew(b: PBIO_METHOD): PBIO;
+begin
+  if InitSSLInterface and Assigned(_BioNew) then
+    Result := _BioNew(b)
+  else
+    Result := nil;
+end;
+
+procedure BioFreeAll(b: PBIO);
+begin
+  if InitSSLInterface and Assigned(_BioFreeAll) then
+    _BioFreeAll(b);
+end;
+
+function BioSMem: PBIO_METHOD;
+begin
+  if InitSSLInterface and Assigned(_BioSMem) then
+    Result := _BioSMem
+  else
+    Result := nil;
+end;
+
+function BioCtrlPending(b: PBIO): integer;
+begin
+  if InitSSLInterface and Assigned(_BioCtrlPending) then
+    Result := _BioCtrlPending(b)
+  else
+    Result := 0;
+end;
+
+//function BioRead(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioRead(b: PBIO; var Buf: String; Len: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_BioRead) then
+    Result := _BioRead(b, PChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
+//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioWrite(b: PBIO; Buf: String; Len: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_BioWrite) then
+    Result := _BioWrite(b, PChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
+function X509print(b: PBIO; a: PX509): integer;
+begin
+  if InitSSLInterface and Assigned(_X509print) then
+    Result := _X509print(b, a)
+  else
+    Result := 0;
+end;
+
+function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+begin
+  if InitSSLInterface and Assigned(_d2iPKCS12bio) then
+    Result := _d2iPKCS12bio(b, Pkcs12)
+  else
+    Result := nil;
+end;
+
+function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer;
+begin
+  if InitSSLInterface and Assigned(_PKCS12parse) then
+    Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca)
+  else
+    Result := 0;
+end;
+
+procedure PKCS12free(p12: SslPtr);
+begin
+  if InitSSLInterface and Assigned(_PKCS12free) then
+    _PKCS12free(p12);
+end;
+
+function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+begin
+  if InitSSLInterface and Assigned(_RsaGenerateKey) then
+    Result := _RsaGenerateKey(bits, e, callback, cb_arg)
+  else
+    Result := nil;
+end;
+
+function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyAssign) then
+    Result := _EvpPkeyAssign(pkey, _type, key)
+  else
+    Result := 0;
+end;
+
+function X509SetVersion(x: PX509; version: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetVersion) then
+    Result := _X509SetVersion(x, version)
+  else
+    Result := 0;
+end;
+
+function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetPubkey) then
+    Result := _X509SetPubkey(x, pkey)
+  else
+    Result := 0;
+end;
+
+function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetIssuerName) then
+    Result := _X509SetIssuerName(x, name)
+  else
+    Result := 0;
+end;
+
+function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
+  bytes: string; len, loc, _set: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then
+    Result := _X509NameAddEntryByTxt(name, PChar(field), _type, PChar(Bytes), len, loc, _set)
+  else
+    Result := 0;
+end;
+
+function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+begin
+  if InitSSLInterface and Assigned(_X509Sign) then
+    Result := _X509Sign(x, pkey, md)
+  else
+    Result := 0;
+end;
+
+function Asn1UtctimeNew: PASN1_UTCTIME;
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimeNew) then
+    Result := _Asn1UtctimeNew
+  else
+    Result := nil;
+end;
+
+procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimeFree) then
+    _Asn1UtctimeFree(a);
+end;
+
+function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+begin
+  if InitSSLInterface and Assigned(_X509GmtimeAdj) then
+    Result := _X509GmtimeAdj(s, adj)
+  else
+    Result := nil;
+end;
+
+function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetNotBefore) then
+    Result := _X509SetNotBefore(x, tm)
+  else
+    Result := 0;
+end;
+
+function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetNotAfter) then
+    Result := _X509SetNotAfter(x, tm)
+  else
+    Result := 0;
+end;
+
+function i2dX509bio(b: PBIO; x: PX509): integer;
+begin
+  if InitSSLInterface and Assigned(_i2dX509bio) then
+    Result := _i2dX509bio(b, x)
+  else
+    Result := 0;
+end;
+
+function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+begin
+  if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
+    Result := _i2dPrivateKeyBio(b, pkey)
+  else
+    Result := 0;
+end;
+
+function EvpGetDigestByName(Name: String): PEVP_MD;
+begin
+  if InitSSLInterface and Assigned(_EvpGetDigestByName) then
+    Result := _EvpGetDigestByName(PChar(Name))
+  else
+    Result := nil;
+end;
+
+function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_Asn1IntegerSet) then
+    Result := _Asn1IntegerSet(a, v)
+  else
+    Result := 0;
+end;
+
+function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+begin
+  if InitSSLInterface and Assigned(_X509GetSerialNumber) then
+    Result := _X509GetSerialNumber(x)
+  else
+    Result := nil;
+end;
+
+// 3DES functions
+procedure DESsetoddparity(Key: des_cblock);
+begin
+  if InitSSLInterface and Assigned(_DESsetoddparity) then
+    _DESsetoddparity(Key);
+end;
+
+function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+begin
+  if InitSSLInterface and Assigned(_DESsetkeychecked) then
+    Result := _DESsetkeychecked(key, schedule)
+  else
+    Result := -1;
+end;
+
+procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+begin
+  if InitSSLInterface and Assigned(_DESecbencrypt) then
+    _DESecbencrypt(Input, output, ks, enc);
+end;
+
+function LoadLib(const Value: String): HModule;
+begin
+  Result := LoadLibrary(Value);
+end;
+
+function GetProcAddr(module: HModule; const ProcName: string): SslPtr;
+begin
+  Result := GetProcAddress(module, PChar(ProcName));
+end;
+
+function InitSSLInterface: Boolean;
+{var
+  s: string;
+  x: integer;}
+begin
+    if not IsSSLloaded then
+    begin
+      SSLLibHandle := LoadLib(DLLSSLName);
+      SSLUtilHandle := LoadLib(DLLUtilName);
+  {$IFNDEF UNIX}
+      if (SSLLibHandle = 0) then
+        SSLLibHandle := LoadLib(DLLSSLName2);
+  {$ENDIF}
+      if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
+      begin
+        _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error');
+        _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init');
+        _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings');
+        _SslCtxSetCipherList := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_cipher_list');
+        _SslCtxNew := GetProcAddr(SSLLibHandle, 'SSL_CTX_new');
+        _SslCtxFree := GetProcAddr(SSLLibHandle, 'SSL_CTX_free');
+        _SslSetFd := GetProcAddr(SSLLibHandle, 'SSL_set_fd');
+        _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method');
+        _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method');
+        _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method');
+        _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method');
+        _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey');
+        _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1');
+        //use SSL_CTX_use_RSAPrivateKey_file instead SSL_CTX_use_PrivateKey_file,
+        //because SSL_CTX_use_PrivateKey_file not support DER format. :-O
+        _SslCtxUsePrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_RSAPrivateKey_file');
+        _SslCtxUseCertificate := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate');
+        _SslCtxUseCertificateASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_ASN1');
+        _SslCtxUseCertificateFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_file');
+        _SslCtxUseCertificateChainFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_chain_file');
+        _SslCtxCheckPrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_check_private_key');
+        _SslCtxSetDefaultPasswdCb := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb');
+        _SslCtxSetDefaultPasswdCbUserdata := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb_userdata');
+        _SslCtxLoadVerifyLocations := GetProcAddr(SSLLibHandle, 'SSL_CTX_load_verify_locations');
+        _SslNew := GetProcAddr(SSLLibHandle, 'SSL_new');
+        _SslFree := GetProcAddr(SSLLibHandle, 'SSL_free');
+        _SslAccept := GetProcAddr(SSLLibHandle, 'SSL_accept');
+        _SslConnect := GetProcAddr(SSLLibHandle, 'SSL_connect');
+        _SslShutdown := GetProcAddr(SSLLibHandle, 'SSL_shutdown');
+        _SslRead := GetProcAddr(SSLLibHandle, 'SSL_read');
+        _SslPeek := GetProcAddr(SSLLibHandle, 'SSL_peek');
+        _SslWrite := GetProcAddr(SSLLibHandle, 'SSL_write');
+        _SslPending := GetProcAddr(SSLLibHandle, 'SSL_pending');
+        _SslGetPeerCertificate := GetProcAddr(SSLLibHandle, 'SSL_get_peer_certificate');
+        _SslGetVersion := GetProcAddr(SSLLibHandle, 'SSL_get_version');
+        _SslCtxSetVerify := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_verify');
+        _SslGetCurrentCipher := GetProcAddr(SSLLibHandle, 'SSL_get_current_cipher');
+        _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name');
+        _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
+        _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
+
+        _X509New := GetProcAddr(SSLUtilHandle, 'X509_new');
+        _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free');
+        _X509NameOneline := GetProcAddr(SSLUtilHandle, 'X509_NAME_oneline');
+        _X509GetSubjectName := GetProcAddr(SSLUtilHandle, 'X509_get_subject_name');
+        _X509GetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_get_issuer_name');
+        _X509NameHash := GetProcAddr(SSLUtilHandle, 'X509_NAME_hash');
+        _X509Digest := GetProcAddr(SSLUtilHandle, 'X509_digest');
+        _X509print := GetProcAddr(SSLUtilHandle, 'X509_print');
+        _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version');
+        _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey');
+        _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name');
+        _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt');
+        _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign');
+        _X509GmtimeAdj := GetProcAddr(SSLUtilHandle, 'X509_gmtime_adj');
+        _X509SetNotBefore := GetProcAddr(SSLUtilHandle, 'X509_set_notBefore');
+        _X509SetNotAfter := GetProcAddr(SSLUtilHandle, 'X509_set_notAfter');
+        _X509GetSerialNumber := GetProcAddr(SSLUtilHandle, 'X509_get_serialNumber');
+        _EvpPkeyNew := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_new');
+        _EvpPkeyFree := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_free');
+        _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign');
+        _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup');
+        _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname');
+        _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
+        _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n');
+        _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error');
+        _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error');
+        _ErrFreeStrings := GetProcAddr(SSLUtilHandle, 'ERR_free_strings');
+        _ErrRemoveState := GetProcAddr(SSLUtilHandle, 'ERR_remove_state');
+        _OPENSSLaddallalgorithms := GetProcAddr(SSLUtilHandle, 'OPENSSL_add_all_algorithms_noconf');
+        _CRYPTOcleanupAllExData := GetProcAddr(SSLUtilHandle, 'CRYPTO_cleanup_all_ex_data');
+        _RandScreen := GetProcAddr(SSLUtilHandle, 'RAND_screen');
+        _BioNew := GetProcAddr(SSLUtilHandle, 'BIO_new');
+        _BioFreeAll := GetProcAddr(SSLUtilHandle, 'BIO_free_all');
+        _BioSMem := GetProcAddr(SSLUtilHandle, 'BIO_s_mem');
+        _BioCtrlPending := GetProcAddr(SSLUtilHandle, 'BIO_ctrl_pending');
+        _BioRead := GetProcAddr(SSLUtilHandle, 'BIO_read');
+        _BioWrite := GetProcAddr(SSLUtilHandle, 'BIO_write');
+        _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio');
+        _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse');
+        _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free');
+        _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key');
+        _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
+        _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
+        _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
+        _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
+        _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
+
+        // 3DES functions
+        _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'DES_set_odd_parity');
+        _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'DES_set_key_checked');
+        _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'DES_ecb_encrypt');
+        //
+        _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks');
+        _CRYPTOsetlockingcallback := GetProcAddr(SSLUtilHandle, 'CRYPTO_set_locking_callback');
+
+{        SetLength(s, 1024);
+        x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s));
+        SetLength(s, x);
+        SSLLibFile := s;
+        SetLength(s, 1024);
+        x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s));
+        SetLength(s, x);
+        SSLUtilFile := s;}
+        //init library
+        if assigned(_SslLibraryInit) then
+          _SslLibraryInit;
+        if assigned(_SslLoadErrorStrings) then
+          _SslLoadErrorStrings;
+        if assigned(_OPENSSLaddallalgorithms) then
+          _OPENSSLaddallalgorithms;
+        if assigned(_RandScreen) then
+          _RandScreen;
+{$WARNING investigate if it REALLY needs to be done}
+{        if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+          InitLocks;}
+
+        Result := True;
+        SSLloaded := True;
+      end
+      else
+      begin
+        //load failed!
+        if SSLLibHandle <> 0 then
+        begin
+          FreeLibrary(SSLLibHandle);
+          SSLLibHandle := 0;
+        end;
+        if SSLUtilHandle <> 0 then
+        begin
+          FreeLibrary(SSLUtilHandle);
+          SSLLibHandle := 0;
+        end;
+        Result := False;
+      end;
+    end
+    else
+      //loaded before...
+      Result := true;
+end;
+
+function DestroySSLInterface: Boolean;
+begin
+    if IsSSLLoaded then
+    begin
+{      //deinit library
+      if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+        FreeLocks;}
+      EVPCleanup;
+      CRYPTOcleanupAllExData;
+      ErrRemoveState(0);
+    end;
+    SSLloaded := false;
+    if SSLLibHandle <> 0 then
+    begin
+      FreeLibrary(SSLLibHandle);
+      SSLLibHandle := 0;
+    end;
+    if SSLUtilHandle <> 0 then
+    begin
+      FreeLibrary(SSLUtilHandle);
+      SSLLibHandle := 0;
+    end;
+
+    _SslGetError := nil;
+    _SslLibraryInit := nil;
+    _SslLoadErrorStrings := nil;
+    _SslCtxSetCipherList := nil;
+    _SslCtxNew := nil;
+    _SslCtxFree := nil;
+    _SslSetFd := nil;
+    _SslMethodV2 := nil;
+    _SslMethodV3 := nil;
+    _SslMethodTLSV1 := nil;
+    _SslMethodV23 := nil;
+    _SslCtxUsePrivateKey := nil;
+    _SslCtxUsePrivateKeyASN1 := nil;
+    _SslCtxUsePrivateKeyFile := nil;
+    _SslCtxUseCertificate := nil;
+    _SslCtxUseCertificateASN1 := nil;
+    _SslCtxUseCertificateFile := nil;
+    _SslCtxUseCertificateChainFile := nil;
+    _SslCtxCheckPrivateKeyFile := nil;
+    _SslCtxSetDefaultPasswdCb := nil;
+    _SslCtxSetDefaultPasswdCbUserdata := nil;
+    _SslCtxLoadVerifyLocations := nil;
+    _SslNew := nil;
+    _SslFree := nil;
+    _SslAccept := nil;
+    _SslConnect := nil;
+    _SslShutdown := nil;
+    _SslRead := nil;
+    _SslPeek := nil;
+    _SslWrite := nil;
+    _SslPending := nil;
+    _SslGetPeerCertificate := nil;
+    _SslGetVersion := nil;
+    _SslCtxSetVerify := nil;
+    _SslGetCurrentCipher := nil;
+    _SslCipherGetName := nil;
+    _SslCipherGetBits := nil;
+    _SslGetVerifyResult := nil;
+
+    _X509New := nil;
+    _X509Free := nil;
+    _X509NameOneline := nil;
+    _X509GetSubjectName := nil;
+    _X509GetIssuerName := nil;
+    _X509NameHash := nil;
+    _X509Digest := nil;
+    _X509print := nil;
+    _X509SetVersion := nil;
+    _X509SetPubkey := nil;
+    _X509SetIssuerName := nil;
+    _X509NameAddEntryByTxt := nil;
+    _X509Sign := nil;
+    _X509GmtimeAdj := nil;
+    _X509SetNotBefore := nil;
+    _X509SetNotAfter := nil;
+    _X509GetSerialNumber := nil;
+    _EvpPkeyNew := nil;
+    _EvpPkeyFree := nil;
+    _EvpPkeyAssign := nil;
+    _EVPCleanup := nil;
+    _EvpGetDigestByName := nil;
+    _SSLeayversion := nil;
+    _ErrErrorString := nil;
+    _ErrGetError := nil;
+    _ErrClearError := nil;
+    _ErrFreeStrings := nil;
+    _ErrRemoveState := nil;
+    _OPENSSLaddallalgorithms := nil;
+    _CRYPTOcleanupAllExData := nil;
+    _RandScreen := nil;
+    _BioNew := nil;
+    _BioFreeAll := nil;
+    _BioSMem := nil;
+    _BioCtrlPending := nil;
+    _BioRead := nil;
+    _BioWrite := nil;
+    _d2iPKCS12bio := nil;
+    _PKCS12parse := nil;
+    _PKCS12free := nil;
+    _RsaGenerateKey := nil;
+    _Asn1UtctimeNew := nil;
+    _Asn1UtctimeFree := nil;
+    _Asn1IntegerSet := nil;
+    _i2dX509bio := nil;
+    _i2dPrivateKeyBio := nil;
+
+    // 3DES functions
+    _DESsetoddparity := nil;
+    _DESsetkeychecked := nil;
+    _DESecbencrypt := nil;
+    //
+    _CRYPTOnumlocks := nil;
+    _CRYPTOsetlockingcallback := nil;
+  Result := True;
+end;
+
+function IsSSLloaded: Boolean;
+begin
+  Result := SSLLoaded;
+end;
+
+finalization
+  DestroySSLInterface;
+
+end.

utils/fppkg/lnet/sys/lepolleventer.inc

@@ -0,0 +1,224 @@
+{% lepolleventer.inc included by levents.pas }
+
+{$ifdef Linux}
+
+{ TLEpollEventer }
+
+const
+  BASE_SIZE = 100;
+  // bug in fpc 2.0.4-
+  EPOLL_CTL_ADD = 1;
+  EPOLL_CTL_DEL = 2;
+  EPOLL_CTL_MOD = 3;
+  
+  EPOLLIN  = $01; { The associated file is available for read(2) operations. }
+  EPOLLPRI = $02; { There is urgent data available for read(2) operations. }
+  EPOLLOUT = $04; { The associated file is available for write(2) operations. }
+  EPOLLERR = $08; { Error condition happened on the associated file descriptor. }
+  EPOLLHUP = $10; { Hang up happened on the associated file descriptor. }
+  EPOLLONESHOT = 1 shl 30;
+  EPOLLET  = 1 shl 31; { Sets  the  Edge  Triggered  behaviour  for  the  associated file descriptor. }
+
+
+constructor TLEpollEventer.Create;
+var
+  lEvent: TEpollEvent;
+begin
+  inherited Create;
+  FFreeList:=TFPObjectList.Create;
+  Inflate;
+  FTimeout:=0;
+  FEpollFD:=epoll_create(BASE_SIZE);
+  FEpollReadFD:=epoll_create(BASE_SIZE);
+  FEpollMasterFD:=epoll_create(2);
+  if (FEPollFD < 0) or (FEpollReadFD < 0) or (FEpollMasterFD < 0) then
+    raise Exception.Create('Unable to create epoll');
+  lEvent.events:=EPOLLIN or EPOLLOUT or EPOLLPRI or EPOLLERR or EPOLLHUP or EPOLLET;
+  lEvent.data.fd:=FEpollFD;
+  if epoll_ctl(FEpollMasterFD, EPOLL_CTL_ADD, FEpollFD, @lEvent) < 0 then
+    raise Exception.Create('Unable to add FDs to master epoll FD');
+  lEvent.data.fd:=FEpollReadFD;
+  if epoll_ctl(FEpollMasterFD, EPOLL_CTL_ADD, FEpollReadFD, @lEvent) < 0 then
+    raise Exception.Create('Unable to add FDs to master epoll FD');
+end;
+
+destructor TLEpollEventer.Destroy;
+begin
+  fpClose(FEpollFD);
+  FFreeList.Free;
+  inherited Destroy;
+end;
+
+function TLEpollEventer.GetTimeout: DWord;
+begin
+  Result:=DWord(FTimeout);
+end;
+
+procedure TLEpollEventer.SetTimeout(const Value: DWord);
+begin
+  FTimeout:=cInt(Value);
+end;
+
+procedure TLEpollEventer.HandleIgnoreRead(aHandle: TLHandle);
+var
+  lEvent: TEpollEvent;
+begin
+  lEvent.data.ptr:=aHandle;
+  lEvent.events:=EPOLLIN or EPOLLPRI or EPOLLHUP;
+  if not aHandle.IgnoreRead then begin
+    if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.Handle, @lEvent) < 0 then
+      Bail('Error modifying handle for reads', LSocketError);
+  end else begin
+    if epoll_ctl(FEpollReadFD, EPOLL_CTL_DEL, aHandle.Handle, @lEvent) < 0 then
+      Bail('Error modifying handle for reads', LSocketError);
+  end;
+end;
+
+procedure TLEpollEventer.Inflate;
+var
+  OldLength: Integer;
+begin
+  OldLength:=Length(FEvents);
+  if OldLength > 1 then
+    SetLength(FEvents, Sqr(OldLength))
+  else
+    SetLength(FEvents, BASE_SIZE);
+  SetLength(FEventsRead, Length(FEvents));
+end;
+
+function TLEpollEventer.AddHandle(aHandle: TLHandle): Boolean;
+
+var
+  lEvent: TEpollEvent;
+begin
+  Result:=inherited AddHandle(aHandle);
+  if Result then begin
+    Result:=False;
+    lEvent.events:=EPOLLET or EPOLLOUT or EPOLLERR;
+    lEvent.data.ptr:=aHandle;
+    if epoll_ctl(FEpollFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
+      Bail('Error adding handle to epoll', LSocketError);
+    lEvent.events:=EPOLLIN or EPOLLPRI or EPOLLHUP;
+    if not aHandle.IgnoreRead then begin
+      if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
+        Bail('Error adding handle to epoll', LSocketError);
+    end;
+    if FCount > High(FEvents) then
+      Inflate;
+  end;
+end;
+
+function Max(const a, b: Integer): Integer; inline;
+begin
+  if a > b then
+    Result:=a
+  else
+    Result:=b;
+end;
+
+function TLEpollEventer.CallAction: Boolean;
+var
+  i, MasterChanges, Changes, ReadChanges: Integer;
+  Temp, TempRead: TLHandle;
+  MasterEvents: array[0..1] of TEpollEvent;
+begin
+  Result:=False;
+  Changes:=0;
+  ReadChanges:=0;
+
+  MasterChanges:=epoll_wait(FEpollMasterFD, @MasterEvents[0], 2, FTimeout);
+
+  if MasterChanges > 0 then begin
+    for i:=0 to MasterChanges-1 do
+      if MasterEvents[i].Data.fd = FEpollFD then
+        Changes:=epoll_wait(FEpollFD, @FEvents[0], FCount, 0)
+      else
+        ReadChanges:=epoll_wait(FEpollReadFD, @FEventsRead[0], FCount, 0);
+    if (Changes < 0) or (ReadChanges < 0) then
+      Bail('Error on epoll: ', LSocketError)
+    else
+      Result:=Changes + ReadChanges > 0;
+      
+    if Result then begin
+      FInLoop:=True;
+      for i:=0 to Max(Changes, ReadChanges)-1 do begin
+        Temp:=nil;
+        if i < Changes then begin
+          Temp:=TLHandle(FEvents[i].data.ptr);
+
+          if  (not Temp.FDispose)
+          and (FEvents[i].events and EPOLLOUT = EPOLLOUT) then
+            if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
+              Temp.FOnWrite(Temp);
+
+          if Temp.FDispose then
+            AddForFree(Temp);
+        end; // writes
+
+        if i < ReadChanges then begin
+          TempRead:=TLHandle(FEventsRead[i].data.ptr);
+
+          if  (not TempRead.FDispose)
+          and ((FEventsRead[i].events and EPOLLIN = EPOLLIN)
+          or  (FEventsRead[i].events and EPOLLHUP = EPOLLHUP)
+          or  (FEventsRead[i].events and EPOLLPRI = EPOLLPRI)) then
+            if Assigned(TempRead.FOnRead) and not TempRead.IgnoreRead then
+              TempRead.FOnRead(TempRead);
+
+          if TempRead.FDispose then
+            AddForFree(TempRead);
+        end; // reads
+        
+        if i < Changes then begin
+          if not Assigned(Temp) then
+            Temp:=TLHandle(FEvents[i].data.ptr);
+
+          if  (not Temp.FDispose)
+          and (FEvents[i].events and EPOLLERR = EPOLLERR) then
+            if Assigned(Temp.FOnError) and not Temp.IgnoreError then
+              Temp.FOnError(Temp, 'Handle error: ' + LStrError(LSocketError));
+
+          if Temp.FDispose then
+            AddForFree(Temp);
+        end; // errors
+      end;
+      FInLoop:=False;
+      if Assigned(FFreeRoot) then
+        FreeHandles;
+    end;
+  end else if MasterChanges < 0 then
+    Bail('Error on epoll: ', LSocketError);
+end;
+
+function BestEventerClass: TLEventerClass;
+
+  function GetVersion(s: string): Integer;
+  const
+    Numbers = ['0'..'9'];
+  var
+    i: Integer;
+  begin
+    s:=StringReplace(s, '.', '', [rfReplaceAll]);
+    i:=1;
+    while (i <= Length(s)) and (s[i] in Numbers) do
+      Inc(i);
+    s:=Copy(s, 1, i - 1);
+    if Length(s) < 4 then // varies OS to OS
+      Insert('0', s, 3); // in linux, last part can be > 10
+    Result:=StrToInt(s);
+  end;
+
+{$ifndef DISABLE_EPOLL}
+var
+  u: TUTSName;
+{$endif}
+begin
+  Result:=TLSelectEventer;
+{$ifndef DISABLE_EPOLL}
+  if fpUname(u) = 0 then   // check for 2.6+
+    if GetVersion(u.release) >= 2600 then
+      Result:=TLEpollEventer;
+{$endif}
+end;
+
+{$endif} // Linux

utils/fppkg/lnet/sys/lepolleventerh.inc

@@ -0,0 +1,32 @@
+{% lepolleventerh.inc included by levents.pas }
+
+{$ifdef Linux}
+
+  PEpollEvent = ^epoll_event;
+  TEpollEvent = epoll_event;
+  PEpollData = ^epoll_data;
+  TEpollData = epoll_data;
+  
+  { TLEpollEventer }
+  
+  TLEpollEventer = class(TLEventer)
+   protected
+    FTimeout: cInt;
+    FEvents: array of TEpollEvent;
+    FEventsRead: array of TEpollEvent;
+    FEpollReadFD: THandle;   // this one monitors LT style for READ
+    FEpollFD: THandle;       // this one monitors ET style for other
+    FEpollMasterFD: THandle; // this one monitors the first two
+    FFreeList: TFPObjectList;
+    function GetTimeout: DWord; override;
+    procedure SetTimeout(const Value: DWord); override;
+    procedure HandleIgnoreRead(aHandle: TLHandle); override;
+    procedure Inflate;
+   public
+    constructor Create; override;
+    destructor Destroy; override;
+    function AddHandle(aHandle: TLHandle): Boolean; override;
+    function CallAction: Boolean; override;
+  end;
+
+{$endif} // linux

utils/fppkg/lnet/sys/lkqueueeventer.inc

@@ -0,0 +1,129 @@
+{% lkqueueeventer.inc included by levents.pas }
+
+{$ifdef BSD}
+
+{ TLKQueueEventer }
+
+constructor TLKQueueEventer.Create;
+begin
+  inherited Create;
+  Inflate;
+  FFreeSlot:=0;
+  FTimeout.tv_sec:=0;
+  FTimeout.tv_nsec:=0;
+  FQueue:=KQueue;
+  if FQueue < 0 then
+    raise Exception.Create('Unable to create kqueue');
+end;
+
+destructor TLKQueueEventer.Destroy;
+begin
+  fpClose(FQueue);
+  inherited Destroy;
+end;
+
+function TLKQueueEventer.GetTimeout: DWord;
+begin
+  Result:=FTimeout.tv_sec + FTimeout.tv_nsec * 1000 * 1000;
+end;
+
+procedure TLKQueueEventer.SetTimeout(const Value: DWord);
+begin
+  FTimeout.tv_sec:=Value div 1000;
+  FTimeout.tv_nsec:=(Value mod 1000) * 1000;
+end;
+
+procedure TLKQueueEventer.HandleIgnoreRead(aHandle: TLHandle);
+const
+  INBOOL: array[Boolean] of Integer = (EV_ENABLE, EV_DISABLE);
+begin
+  EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ,
+         INBOOL[aHandle.IgnoreRead], 0, 0, Pointer(aHandle));
+
+  Inc(FFreeSlot);
+  if FFreeSlot > Length(FChanges) then
+    Inflate;
+end;
+
+procedure TLKQueueEventer.Inflate;
+const
+  BASE_SIZE = 100;
+var
+  OldLength: Integer;
+begin
+  OldLength:=Length(FChanges);
+  if OldLength > 1 then begin
+    SetLength(FChanges, Sqr(OldLength));
+    SetLength(FEvents, Sqr(OldLength));
+  end else begin
+    SetLength(FChanges, BASE_SIZE);
+    SetLength(FEvents, BASE_SIZE);
+  end;
+end;
+
+function TLKQueueEventer.AddHandle(aHandle: TLHandle): Boolean;
+begin
+  Result:=inherited AddHandle(aHandle);
+
+  if FFreeSlot > Length(FChanges) then
+    Inflate;
+  EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_WRITE,
+         EV_ADD or EV_CLEAR, 0, 0, Pointer(aHandle));
+  Inc(FFreeSlot);
+
+  if FFreeSlot > Length(FChanges) then
+    Inflate;
+  if not aHandle.FIgnoreRead then begin
+    EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ,
+           EV_ADD, 0, 0, Pointer(aHandle));
+    Inc(FFreeSlot);
+  end;
+end;
+
+function TLKQueueEventer.CallAction: Boolean;
+var
+  i, n: Integer;
+  Temp: TLHandle;
+begin
+  n:=KEvent(FQueue, @FChanges[0], FFreeSlot,
+            @FEvents[0], Length(FEvents), @FTimeout);
+  FFreeSlot:=0;
+  if n < 0 then
+    Bail('Error on kqueue: ', LSocketError);
+  Result:=n > 0;
+  if Result then begin
+    FInLoop:=True;
+    for i:=0 to n-1 do begin
+      Temp:=TLHandle(FEvents[i].uData);
+      
+      if  (not Temp.FDispose)
+      and (FEvents[i].Filter = EVFILT_WRITE) then
+        if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
+          Temp.FOnWrite(Temp);
+
+      if  (not Temp.FDispose)
+      and (FEvents[i].Filter = EVFILT_READ) then
+        if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then
+          Temp.FOnRead(Temp);
+      
+      if  (not Temp.FDispose)
+      and ((FEvents[i].Flags and EV_ERROR) > 0) then
+        if Assigned(Temp.FOnError) and not Temp.IgnoreError then
+          Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError));
+
+      if Temp.FDispose then
+        AddForFree(Temp);
+    end;
+    FInLoop:=False;
+    if Assigned(FFreeRoot) then
+      FreeHandles;
+  end;
+end;
+
+function BestEventerClass: TLEventerClass;
+begin
+  Result:=TLKQueueEventer;
+end;
+
+{$endif} // BSD
+

utils/fppkg/lnet/sys/lkqueueeventerh.inc

@@ -0,0 +1,25 @@
+{% lkqueueeventerh.inc included by levents.pas }
+
+{$ifdef BSD}
+
+  { TLKQueueEventer }
+
+  TLKQueueEventer = class(TLEventer)
+   protected
+    FTimeout: TTimeSpec;
+    FEvents: array of TKEvent;
+    FChanges: array of TKEvent;
+    FFreeSlot: Integer;
+    FQueue: THandle;
+    function GetTimeout: DWord; override;
+    procedure SetTimeout(const Value: DWord); override;
+    procedure HandleIgnoreRead(aHandle: TLHandle); override;
+    procedure Inflate;
+   public
+    constructor Create; override;
+    destructor Destroy; override;
+    function AddHandle(aHandle: TLHandle): Boolean; override;
+    function CallAction: Boolean; override;
+  end;
+  
+{$endif} // bsd

utils/fppkg/lnet/sys/lspawnfcgiunix.inc

@@ -0,0 +1,51 @@
+uses
+  Classes, BaseUnix;
+
+function SpawnFCGIProcess(App, Enviro: string; const aPort: Word): Integer;
+var
+  TheSocket: TLSocket;
+  i: Integer;
+  SL: TStringList;
+  aNil: Pointer = nil;
+  ppEnv, ppArgs: ppChar;
+begin
+  Result:=FpFork;
+
+  if Result = 0 then begin
+    ppArgs:=@aNil;
+
+    for i:=3 to 10000 do
+      CloseSocket(i);
+
+    if CloseSocket(StdInputHandle) <> 0 then
+      Exit(LSocketError);
+
+    TheSocket:=TLSocket.Create;
+    TheSocket.Blocking:=True;
+
+    if not TheSocket.Listen(aPort) then
+      Exit(LSocketError);
+
+    ppEnv:=@aNil;
+
+    if Length(Enviro) > 0 then begin
+      SL:=TStringList.Create;
+      repeat
+        i:=Pos(':', Enviro);
+        if i > 0 then begin
+          SL.Add(Copy(Enviro, 1, i - 1));
+          Delete(Enviro, 1, i);
+        end else
+          SL.Add(Enviro);
+      until i = 0;
+      GetMem(ppEnv, SizeOf(pChar) * (SL.Count + 1));
+      for i:=0 to SL.Count-1 do
+        ppEnv[i]:=pChar(SL[i]);
+      ppEnv[SL.Count]:=nil;
+    end;
+    
+    FpExecve(pChar(App), ppArgs, ppEnv);
+  end else if Result > 0 then
+    Result:=0; // it went ok
+end;
+

utils/fppkg/lnet/sys/lspawnfcgiwin.inc

@@ -0,0 +1,7 @@
+
+
+function SpawnFCGIProcess(App, Enviro: string; const aPort: Word): Integer;
+begin
+  Result:=0; // TODO: implement
+end;
+

utils/fppkg/lnet/sys/osunits.inc

@@ -0,0 +1,18 @@
+{$ifdef WINDOWS}
+  Winsock2,
+{$endif}
+
+{$ifdef UNIX}
+  BaseUnix, NetDB,
+{$endif}
+
+{$ifdef NETWARE}
+  WinSock,
+{$endif}
+
+{$ifdef OS2}
+  WinSock,
+{$endif}
+
+  SysUtils, Sockets;
+