AnyEvent-FTP-0.20/ 000755 000000 000000 00000000000 15123245460 013573 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/Changes 000644 000000 000000 00000004340 15123245460 015067 0 ustar 00root root 000000 000000 Revision history for AnyEvent-FTP
0.20 2025-12-25 07:33:15 -0700
- Remove EV as a prereq (gh#36)
0.19 2022-04-12 10:33:09 -0600
- Fix prereq on autodie (gh#33)
- Fix bug in where socket handle wasn't being properly
destroyed after use (gh#32)
0.18 2021-10-28 09:18:40 -0600
- Fix test that could fail on some platforms because
regexp wasn't correctly escaped (gh#31)
0.17 2021-07-12 08:43:17 -0600
- Fix bug related to space being in %PATH% on Windows
- Another fix on Perl where test suite could fail if
installed from a different volume than the temp
directory.
- Add dependency on Capture::Tiny
- Relax Perl requirement to 5.10.0 (had been
5.10.1)
0.16 2017-08-30 09:08:58 -0400
- Fix to timeout in now longer running client test
- Fix to test that was not optionally using EV
0.15 2017-08-29 18:39:58 -0400
- Migrate to EUMM
0.14 2017-07-26 07:42:52 -0400
- Remove dependency on List::MoreUtils
- Migrate from File::ShareDir to File::ShareDir::Dist
0.11 2017-07-22 23:58:59 -0400
- Remove dependency on File::HomeDir
0.10 2017-07-07 18:13:24 -0400
- Bundle ls from Perl Power Tools for platforms that do not
have a compliant ls
0.09 2015-08-03 14:38:44 -0400
- AnyEvent::FTP::Server::Context::FSRW no longer attempts to return
a directory as a file via RETR
0.08 2015-03-03 23:30:40 -0500
- Require Moo 2.0, as older versions inadvertently turn on
fatal warnings
0.07 2015-01-26 09:43:21 -0500
- Grammar and spacing fixes in documentation (GH#22 thanks shlomif)
- Improved documentation coverage (GH#22 thanks shlomif)
0.06 2014-10-29 07:55:23 -0400
- Build.PL now exits instead of dies on wrong Perl version
0.05 2014-09-09 08:49:13 -0400
- promote to production
0.04_01 2014-08-21 13:34:15 -0400
- set LC_ALL=C in tests to avoid possible locale missmatches
0.04 2014-08-09 07:32:40 -0400
- make default for test timeout be 120s
0.03 2014-08-05 08:13:16 -0400
- fix for test failure on MSWin32
0.02 2014-08-05 07:20:55 -0400
- fix test failure on non C/English locales (thanks syohex)
- fix test on OS X (thanks ryochin)
0.01 2014-08-04 16:49:27 -0400
- initial version
AnyEvent-FTP-0.20/INSTALL 000644 000000 000000 00000004553 15123245460 014633 0 ustar 00root root 000000 000000 This is the Perl distribution AnyEvent-FTP.
Installing AnyEvent-FTP is straightforward.
## Installation with cpanm
If you have cpanm, you only need one line:
% cpanm AnyEvent::FTP
If it does not have permission to install modules to the current perl, cpanm
will automatically set up and install to a local::lib in your home directory.
See the local::lib documentation (https://metacpan.org/pod/local::lib) for
details on enabling it in your environment.
## Installing with the CPAN shell
Alternatively, if your CPAN shell is set up, you should just be able to do:
% cpan AnyEvent::FTP
## Manual installation
As a last resort, you can manually install it. If you have not already
downloaded the release tarball, you can find the download link on the module's
MetaCPAN page: https://metacpan.org/pod/AnyEvent::FTP
Untar the tarball, install configure prerequisites (see below), then build it:
% perl Makefile.PL
% make && make test
Then install it:
% make install
On Windows platforms, you should use `dmake` or `nmake`, instead of `make`.
If your perl is system-managed, you can create a local::lib in your home
directory to install modules to. For details, see the local::lib documentation:
https://metacpan.org/pod/local::lib
The prerequisites of this distribution will also have to be installed manually. The
prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated
by running the manual build process described above.
## Configure Prerequisites
This distribution requires other modules to be installed before this
distribution's installer can be run. They can be found under the
"configure_requires" key of META.yml or the
"{prereqs}{configure}{requires}" key of META.json.
## Other Prerequisites
This distribution may require additional modules to be installed after running
Makefile.PL.
Look for prerequisites in the following phases:
* to run make, PHASE = build
* to use the module code itself, PHASE = runtime
* to run tests, PHASE = test
They can all be found in the "PHASE_requires" key of MYMETA.yml or the
"{prereqs}{PHASE}{requires}" key of MYMETA.json.
## Documentation
AnyEvent-FTP documentation is available as POD.
You can run `perldoc` from a shell to read the documentation:
% perldoc AnyEvent::FTP
For more information on installing Perl modules via CPAN, please see:
https://www.cpan.org/modules/INSTALL.html
AnyEvent-FTP-0.20/LICENSE 000644 000000 000000 00000046320 15123245460 014605 0 ustar 00root root 000000 000000 This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2017-2022 by Graham Ollis.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, 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 software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) 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.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the 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 Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, 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
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. 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 PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively 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.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, see .
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Moe Ghoul, President of Vice
That's all there is to it!
--- The Perl Artistic License 1.0 ---
This software is Copyright (c) 2017-2022 by Graham Ollis.
This is free software, licensed under:
The Perl Artistic License 1.0
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
AnyEvent-FTP-0.20/MANIFEST 000644 000000 000000 00000006452 15123245460 014733 0 ustar 00root root 000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.036.
Changes
INSTALL
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
author.yml
bin/aeftpd
corpus/nlst/one.txt
corpus/nlst/three.txt
corpus/nlst/two.txt
dist.ini
example/blocking_retr.pl
example/fget.pl
example/fls.pl
example/fput.pl
example/lib/AnyEvent/FTP/Server/Context/EchoContext.pm
example/list.pl
example/non_blocking_retr.pl
inc/ServerTests.pm
lib/AnyEvent/FTP.pm
lib/AnyEvent/FTP/Client.pm
lib/AnyEvent/FTP/Client/Response.pm
lib/AnyEvent/FTP/Client/Role/FetchTransfer.pm
lib/AnyEvent/FTP/Client/Role/ListTransfer.pm
lib/AnyEvent/FTP/Client/Role/RequestBuffer.pm
lib/AnyEvent/FTP/Client/Role/ResponseBuffer.pm
lib/AnyEvent/FTP/Client/Role/StoreTransfer.pm
lib/AnyEvent/FTP/Client/Site.pm
lib/AnyEvent/FTP/Client/Site/Base.pm
lib/AnyEvent/FTP/Client/Site/Microsoft.pm
lib/AnyEvent/FTP/Client/Site/NetFtpServer.pm
lib/AnyEvent/FTP/Client/Site/Proftpd.pm
lib/AnyEvent/FTP/Client/Transfer.pm
lib/AnyEvent/FTP/Client/Transfer/Active.pm
lib/AnyEvent/FTP/Client/Transfer/Passive.pm
lib/AnyEvent/FTP/Request.pm
lib/AnyEvent/FTP/Response.pm
lib/AnyEvent/FTP/Role/Event.pm
lib/AnyEvent/FTP/Server.pm
lib/AnyEvent/FTP/Server/Connection.pm
lib/AnyEvent/FTP/Server/Context.pm
lib/AnyEvent/FTP/Server/Context/FS.pm
lib/AnyEvent/FTP/Server/Context/FSRO.pm
lib/AnyEvent/FTP/Server/Context/FSRW.pm
lib/AnyEvent/FTP/Server/Context/Memory.pm
lib/AnyEvent/FTP/Server/OS/UNIX.pm
lib/AnyEvent/FTP/Server/Role/Auth.pm
lib/AnyEvent/FTP/Server/Role/Context.pm
lib/AnyEvent/FTP/Server/Role/Help.pm
lib/AnyEvent/FTP/Server/Role/Old.pm
lib/AnyEvent/FTP/Server/Role/ResponseEncoder.pm
lib/AnyEvent/FTP/Server/Role/TransferPrep.pm
lib/AnyEvent/FTP/Server/Role/Type.pm
lib/AnyEvent/FTP/Server/UnambiguousResponseEncoder.pm
lib/Test/AnyEventFTPServer.pm
maint/gen.pl
maint/travis-install-file-sharedir-dist
perlcriticrc
share/ppt/ls.pl
t/00_diag.t
t/01_use.t
t/anyevent_ftp.t
t/anyevent_ftp_client.t
t/anyevent_ftp_client__cwd.t
t/anyevent_ftp_client_response.t
t/anyevent_ftp_client_role_responsebuffer.t
t/anyevent_ftp_client_site.t
t/anyevent_ftp_role_event.t
t/anyevent_ftp_server_connection.t
t/anyevent_ftp_server_context_fs.t
t/anyevent_ftp_server_context_fsrw__ascii.t
t/anyevent_ftp_server_context_fsrw__help_coverage.t
t/anyevent_ftp_server_context_fsrw__unauth.t
t/anyevent_ftp_server_context_memory__cdup.t
t/anyevent_ftp_server_context_memory__cwd.t
t/anyevent_ftp_server_context_memory__dele.t
t/anyevent_ftp_server_context_memory__help_coverage.t
t/anyevent_ftp_server_context_memory__mkd.t
t/anyevent_ftp_server_context_memory__nlst.t
t/anyevent_ftp_server_context_memory__pwd.t
t/anyevent_ftp_server_context_memory__rename.t
t/anyevent_ftp_server_context_memory__rmd.t
t/anyevent_ftp_server_context_memory__size.t
t/anyevent_ftp_server_context_memory__stat.t
t/anyevent_ftp_server_role_auth.t
t/anyevent_ftp_server_role_help.t
t/anyevent_ftp_server_role_old.t
t/anyevent_ftp_server_role_transferprep.t
t/anyevent_ftp_server_role_type.t
t/anyevent_ftp_server_unambiguousresponseencoder.t
t/lib/Test2/Tools/ClientTests.pm
t/test_anyeventftpserver.t
tools/issue10.pl
tools/test_client.pl
xt/author/critic.t
xt/author/eol.t
xt/author/no_tabs.t
xt/author/pod.t
xt/author/pod_coverage.t
xt/author/pod_spelling_common.t
xt/author/strict.t
xt/author/version.t
xt/release/changes.t
xt/release/fixme.t
AnyEvent-FTP-0.20/META.json 000644 000000 000000 00000015514 15123245460 015222 0 ustar 00root root 000000 000000 {
"abstract" : "Simple asynchronous FTP client and server",
"author" : [
"Graham Ollis "
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.036, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "AnyEvent-FTP",
"no_index" : {
"directory" : [
"example",
"tools"
]
},
"prereqs" : {
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::ShareDir::Install" : "0.06",
"perl" : "5.010"
}
},
"develop" : {
"recommends" : {
"Dist::Zilla::Plugin::Author::Plicease::Thanks" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::Plugin::InsertExample" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::PruneFiles" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.69",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::Community::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Community::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Community::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Community::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Community::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Community::DollarAB" : "0",
"Perl::Critic::Policy::Community::Each" : "0",
"Perl::Critic::Policy::Community::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Community::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Community::LoopOnHash" : "0",
"Perl::Critic::Policy::Community::ModPerl" : "0",
"Perl::Critic::Policy::Community::OpenArgs" : "0",
"Perl::Critic::Policy::Community::OverloadOptions" : "0",
"Perl::Critic::Policy::Community::POSIXImports" : "0",
"Perl::Critic::Policy::Community::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Community::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Community::StrictWarnings" : "0",
"Perl::Critic::Policy::Community::Threads" : "0",
"Perl::Critic::Policy::Community::Wantarray" : "0",
"Perl::Critic::Policy::Community::WarningsSwitch" : "0",
"Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"Perl::Critic" : "0",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::Spelling::CommonMistakes" : "0",
"Test::Strict" : "0"
}
},
"runtime" : {
"requires" : {
"AnyEvent" : "0",
"Capture::Tiny" : "0",
"File::ShareDir::Dist" : "0",
"File::Which" : "0",
"File::chdir" : "0",
"Moo" : "2.0",
"Path::Class" : "0.26",
"PerlIO::eol" : "0",
"Test2::API" : "1.302015",
"URI" : "0",
"autodie" : "0",
"perl" : "5.010"
}
},
"test" : {
"requires" : {
"Test2::V0" : "0.000121",
"perl" : "5.010"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/uperl/AnyEvent-FTP/issues"
},
"homepage" : "https://metacpan.org/pod/AnyEvent::FTP",
"repository" : {
"type" : "git",
"url" : "git://github.com/uperl/AnyEvent-FTP.git",
"web" : "https://github.com/uperl/AnyEvent-FTP"
}
},
"version" : "0.20",
"x_contributors" : [
"Graham Ollis ",
"Ryo Okamoto",
"Shlomi Fish",
"Jos\u00e9 Joaqu\u00edn Atria"
],
"x_generated_by_perl" : "v5.42.0",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.40",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
AnyEvent-FTP-0.20/META.yml 000644 000000 000000 00000002321 15123245460 015042 0 ustar 00root root 000000 000000 ---
abstract: 'Simple asynchronous FTP client and server'
author:
- 'Graham Ollis '
build_requires:
Test2::V0: '0.000121'
perl: '5.010'
configure_requires:
ExtUtils::MakeMaker: '0'
File::ShareDir::Install: '0.06'
perl: '5.010'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.036, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: AnyEvent-FTP
no_index:
directory:
- example
- tools
requires:
AnyEvent: '0'
Capture::Tiny: '0'
File::ShareDir::Dist: '0'
File::Which: '0'
File::chdir: '0'
Moo: '2.0'
Path::Class: '0.26'
PerlIO::eol: '0'
Test2::API: '1.302015'
URI: '0'
autodie: '0'
perl: '5.010'
resources:
bugtracker: https://github.com/uperl/AnyEvent-FTP/issues
homepage: https://metacpan.org/pod/AnyEvent::FTP
repository: git://github.com/uperl/AnyEvent-FTP.git
version: '0.20'
x_contributors:
- 'Graham Ollis '
- 'Ryo Okamoto'
- 'Shlomi Fish'
- 'José Joaquín Atria'
x_generated_by_perl: v5.42.0
x_serialization_backend: 'YAML::Tiny version 1.76'
x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later'
x_use_unsafe_inc: 0
AnyEvent-FTP-0.20/Makefile.PL 000644 000000 000000 00000014347 15123245460 015556 0 ustar 00root root 000000 000000 BEGIN {
use strict; use warnings;
unless(eval q{ use 5.010; 1}) {
print "Perl 5.010 or better required\n";
exit;
}
}
# This file was automatically generated by Dist::Zilla::Plugin::Author::Plicease::MakeMaker v2.79.
use strict;
use warnings;
use 5.010;
use ExtUtils::MakeMaker;
use File::ShareDir::Install;
$File::ShareDir::Install::INCLUDE_DOTFILES = 1;
$File::ShareDir::Install::INCLUDE_DOTDIRS = 1;
install_share dist => "share";
my %WriteMakefileArgs = (
"ABSTRACT" => "Simple asynchronous FTP client and server",
"AUTHOR" => "Graham Ollis ",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0,
"File::ShareDir::Install" => "0.06"
},
"DISTNAME" => "AnyEvent-FTP",
"EXE_FILES" => [
"bin/aeftpd"
],
"LICENSE" => "perl",
"MIN_PERL_VERSION" => "5.010",
"NAME" => "AnyEvent::FTP",
"PM" => {
"lib/AnyEvent/FTP.pm" => "\$(INST_LIB)/AnyEvent/FTP.pm",
"lib/AnyEvent/FTP/Client.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client.pm",
"lib/AnyEvent/FTP/Client/Response.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Response.pm",
"lib/AnyEvent/FTP/Client/Role/FetchTransfer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Role/FetchTransfer.pm",
"lib/AnyEvent/FTP/Client/Role/ListTransfer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Role/ListTransfer.pm",
"lib/AnyEvent/FTP/Client/Role/RequestBuffer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Role/RequestBuffer.pm",
"lib/AnyEvent/FTP/Client/Role/ResponseBuffer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Role/ResponseBuffer.pm",
"lib/AnyEvent/FTP/Client/Role/StoreTransfer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Role/StoreTransfer.pm",
"lib/AnyEvent/FTP/Client/Site.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Site.pm",
"lib/AnyEvent/FTP/Client/Site/Base.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Site/Base.pm",
"lib/AnyEvent/FTP/Client/Site/Microsoft.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Site/Microsoft.pm",
"lib/AnyEvent/FTP/Client/Site/NetFtpServer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Site/NetFtpServer.pm",
"lib/AnyEvent/FTP/Client/Site/Proftpd.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Site/Proftpd.pm",
"lib/AnyEvent/FTP/Client/Transfer.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Transfer.pm",
"lib/AnyEvent/FTP/Client/Transfer/Active.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Transfer/Active.pm",
"lib/AnyEvent/FTP/Client/Transfer/Passive.pm" => "\$(INST_LIB)/AnyEvent/FTP/Client/Transfer/Passive.pm",
"lib/AnyEvent/FTP/Request.pm" => "\$(INST_LIB)/AnyEvent/FTP/Request.pm",
"lib/AnyEvent/FTP/Response.pm" => "\$(INST_LIB)/AnyEvent/FTP/Response.pm",
"lib/AnyEvent/FTP/Role/Event.pm" => "\$(INST_LIB)/AnyEvent/FTP/Role/Event.pm",
"lib/AnyEvent/FTP/Server.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server.pm",
"lib/AnyEvent/FTP/Server/Connection.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Connection.pm",
"lib/AnyEvent/FTP/Server/Context.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Context.pm",
"lib/AnyEvent/FTP/Server/Context/FS.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Context/FS.pm",
"lib/AnyEvent/FTP/Server/Context/FSRO.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Context/FSRO.pm",
"lib/AnyEvent/FTP/Server/Context/FSRW.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Context/FSRW.pm",
"lib/AnyEvent/FTP/Server/Context/Memory.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Context/Memory.pm",
"lib/AnyEvent/FTP/Server/OS/UNIX.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/OS/UNIX.pm",
"lib/AnyEvent/FTP/Server/Role/Auth.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/Auth.pm",
"lib/AnyEvent/FTP/Server/Role/Context.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/Context.pm",
"lib/AnyEvent/FTP/Server/Role/Help.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/Help.pm",
"lib/AnyEvent/FTP/Server/Role/Old.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/Old.pm",
"lib/AnyEvent/FTP/Server/Role/ResponseEncoder.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/ResponseEncoder.pm",
"lib/AnyEvent/FTP/Server/Role/TransferPrep.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/TransferPrep.pm",
"lib/AnyEvent/FTP/Server/Role/Type.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/Role/Type.pm",
"lib/AnyEvent/FTP/Server/UnambiguousResponseEncoder.pm" => "\$(INST_LIB)/AnyEvent/FTP/Server/UnambiguousResponseEncoder.pm",
"lib/Test/AnyEventFTPServer.pm" => "\$(INST_LIB)/Test/AnyEventFTPServer.pm"
},
"PREREQ_PM" => {
"AnyEvent" => 0,
"Capture::Tiny" => 0,
"File::ShareDir::Dist" => 0,
"File::Which" => 0,
"File::chdir" => 0,
"Moo" => "2.0",
"Path::Class" => "0.26",
"PerlIO::eol" => 0,
"Test2::API" => "1.302015",
"URI" => 0,
"autodie" => 0
},
"TEST_REQUIRES" => {
"Test2::V0" => "0.000121"
},
"VERSION" => "0.20",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"AnyEvent" => 0,
"Capture::Tiny" => 0,
"File::ShareDir::Dist" => 0,
"File::Which" => 0,
"File::chdir" => 0,
"Moo" => "2.0",
"Path::Class" => "0.26",
"PerlIO::eol" => 0,
"Test2::API" => "1.302015",
"Test2::V0" => "0.000121",
"URI" => 0,
"autodie" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
{
package
MY;
use File::ShareDir::Install qw(postamble);
} AnyEvent-FTP-0.20/README 000644 000000 000000 00000005307 15123245460 014460 0 ustar 00root root 000000 000000 NAME
AnyEvent::FTP - Simple asynchronous FTP client and server
VERSION
version 0.20
SYNOPSIS
# For the client
use AnyEvent::FTP::Client;
# For the server
use AnyEvent::FTP::Server;
DESCRIPTION
This distribution provides client and server implementations for File
Transfer Protocol (FTP) in an AnyEvent environment. For the specific
interfaces, see AnyEvent::FTP::Client and AnyEvent::FTP::Server for
details.
Before each release, AnyEvent::FTP::Client is tested against these FTP
servers using the t/client_*.t tests that come with this distribution:
Proftpd
wu-ftpd
Net::FTPServer
vsftpd
Pure-FTPd
bftpd
AnyEvent::FTP::Server
The client code is also tested less frequently against these FTP
servers:
NcFTPd
Microsoft IIS
It used to also be tested against the VMS ftp server, so it was
verified to work with it, at least at one point. However, I no longer
have access to that server.
BUNDLED FILES
This distribution comes bundled with ls from the old Perl Power Tools
project. This is only used on
MSWin32 if this command is not found in the path, as it is frequently
not available on that platform
The Perl implementation of ls was written by Mark Leighton Fisher of
Thomson Consumer Electronics, fisherm@tce.com.
That program is free and open software. You may use, modify,
distribute, and sell it program (and any modified variants) in any way
you wish, provided you do not restrict others from doing the same.
SEE ALSO
* AnyEvent::FTP::Client
* AnyEvent::FTP::Server
* Net::FTP
* Net::FTPServer
* AnyEvent
* RFC 959 FILE TRANSFER PROTOCOL
* RFC 2228 FTP Security Extensions
* RFC 2640 Internationalization of the File Transfer Protocol
* RFC 2773 Encryption using KEA and SKIPJACK
* RFC 3659 Extensions to FTP
* RFC 5797 FTP Command and Extension Registry
* http://cr.yp.to/ftp.html
* http://en.wikipedia.org/wiki/List_of_FTP_server_return_codes
AUTHOR
Author: Graham Ollis
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
AnyEvent-FTP-0.20/author.yml 000644 000000 000000 00000004417 15123245460 015626 0 ustar 00root root 000000 000000 ---
pod_spelling_system:
# list of words that are spelled correctly
# (regardless of what spell check thinks)
stopwords:
- AnyEvent
- BUILDARGS
- IIS
- PASV
- URI
- filename
- filenames
- login
- proftpd
- KEA
- SKIPJACK
- IP
- unparsed
- fget
- fput
- fls
- aeftpd
- CDPATH
- CHECKMETHOD
- CHECKSUM
- cb
- callbacks
- callback
- pl
- APPE
- CDUP
- CWD
- DELE
- MKD
- NLST
- PWD
- Readonly
- RMD
- RNFR
- RNTO
- STAT
- STOR
- STOU
- FTPd
- bftpd
- ftpd
- vsftpd
- wu
- NcFTPd
- syst
- SYST
- ALLO
- standalone
- stderr
- auth
- cred
- inet
- pam
- readonly
- RETR
- VMS
- authenticator
- TCP
- FSRW
- vett
- customizations
- Okamoto
- Ryo
- Shlomi
# lol
- ACFLRSTWacdfgiklmnopqrstux
- dev
- Joaquín
- José
- Leighton
- RSacdfiklnrstu
pod_coverage:
# format is "Class#method" or "Class", regex allowed
# for either Class or method.
private:
- .*#new
- .*#BUILD
- .*#BUILDARGS
- AnyEvent::FTP::Client::Role::RequestBuffer
- AnyEvent::FTP::Client::Role::ResponseBuffer
- AnyEvent::FTP::Client::Transfer#(handle|client|command|local|restart)
- AnyEvent::FTP::Client::Transfer::Active
- AnyEvent::FTP::Client::Transfer::Passive
- AnyEvent::FTP::Client::Role::FetchTransfer
- AnyEvent::FTP::Client::Role::ListTransfer
- AnyEvent::FTP::Client::Role::StoreTransfer
# server context requires coverage of commands,
# not methods
- AnyEvent::FTP::Server::Context::(FS(|RW|RO)|Memory)#(cmd_|help_).*
- AnyEvent::FTP::Server::Role::(TransferPrep|Auth|Help|Old|Type)#(cmd_|help_).*
# The ::Site:: module documentation actually cover these methods,
# but Test::Pod::Coverage doesn't like the multipe arrow thing that is
# going on there, but I think it be more clear
- AnyEvent::FTP::Client::Site::Base#client
- AnyEvent::FTP::Client::Site::Microsoft#dirstyle
- AnyEvent::FTP::Client::Site::NetFtpServer#version
- AnyEvent::FTP::Client::Site::Proftpd#(chgrp|chmod|help|quota|ratio|rmdir|symlink|utime|mkdir)
unused_vars:
skip: 1
AnyEvent-FTP-0.20/bin/ 000755 000000 000000 00000000000 15123245460 014343 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/bin/aeftpd 000755 000000 000000 00000015236 15123245460 015543 0 ustar 00root root 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use AnyEvent;
use AnyEvent::FTP::Server;
use Getopt::Long qw( GetOptions );
use URI;
use Pod::Usage qw( pod2usage );
# PODNAME: aeftpd
# ABSTRACT: FTP Server
our $VERSION = '0.20'; # VERSION
my $port;
my $host;
my $inet = 0;
my $stderr;
my $chroot = 0;
my $verbose = 0;
my $cred;
my $simple_auth_class;
my @simple_auth_args;
my $default_context = 'FSRW';
GetOptions(
'port=i' => \$port,
'hostname=s' => \$host,
'inet' => \$inet,
'stderr=s' => \$stderr,
'pam=s' => sub { $simple_auth_class = 'PAM'; push @simple_auth_args, service => $_[1] },
'chroot' => \$chroot,
'verbose' => \$verbose,
'cred=s' => \$cred,
'context=s' => \$default_context,
'auth=s' => sub { $_[1] =~ /^(.*?)=(.*)$/ ? (push @simple_auth_args, $1 => $2) : ($simple_auth_class = $_[1]) },
'help|h' => sub { pod2usage({ -verbose => 2}) },
'version' => sub { say 'aeftp/AnyEvent::FTP version ', ($AnyEvent::FTP::Server::VERSION // 'dev'); exit 1 },
) || pod2usage(1);
$0 = 'aeftpd';
$port //= ($> && $^O !~ /^(cygwin|MSWin32)$/) ? undef : 21;
if($stderr)
{
open STDERR, '>>', $stderr;
}
$cred = 'random'
if ! defined($cred) && ! defined($simple_auth_class);
if(defined $cred && $cred eq 'random')
{
$cred = {
user => (join '', map { chr(ord('a') + int rand(26)) } (1..10)),
pass => (join '', map { chr(ord('a') + int rand(26)) } (1..10)),
};
}
elsif(defined $cred)
{
my($user,$pass) = split /:/, $cred;
unless(defined $pass)
{
say STDERR "password not provided for --cred option";
exit 2;
}
$cred = {
user => $user,
pass => $pass,
};
}
$default_context = "AnyEvent::FTP::Server::Context::$default_context"
unless $default_context =~ /::/;
my $server = AnyEvent::FTP::Server->new(
hostname => $host,
port => $port,
inet => $inet,
default_context => $default_context,
);
unless($inet)
{
$server->on_bind(sub {
my $uri = URI->new('ftp:');
$uri->host($host // 'localhost');
$uri->port(shift);
$uri->userinfo(join ':', $cred->{user}, $cred->{pass})
if defined $cred;
say $uri;
});
}
if($verbose)
{
$server->on_connect(sub {
my $con = shift;
$con->on_request(sub {
my $raw = shift;
say STDERR "CLIENT: $raw";
});
$con->on_response(sub {
my $raw = shift;
$raw =~ s/\015?\012$//g;
say STDERR "SERVER: $raw";
});
$con->on_close(sub {
say STDERR "DISCONNECT";
});
say STDERR "CONNECT";
});
}
if($cred)
{
$server->on_connect(sub {
my $con = shift;
$con->context->authenticator(sub {
my($name, $pass) = @_;
return $name eq $cred->{user}
&& $pass eq $cred->{pass};
});
});
}
elsif($simple_auth_class)
{
eval 'use Authen::Simple::' . $simple_auth_class;
if($@)
{
say STDERR "install Authen::Simple::$simple_auth_class in order to use $simple_auth_class authentication";
exit 2;
}
my $pam = "Authen::Simple::$simple_auth_class"->new(
@simple_auth_args,
);
$server->on_connect(sub {
my $con = shift;
my $user_class;
if($inet && $< == 0 && $^O !~ /^(cygwin|MSWin32)$/)
{
$user_class = 'AnyEvent::FTP::Server::OS::UNIX';
eval "use $user_class"; die $@ if $@;
}
$con->context->authenticator(sub {
my($name, $pass) = @_;
$name = 'ftp' if $name eq 'anonymous';
my $user;
if(defined $user_class)
{
$user = eval { $user_class->new($name) };
return 0 if $@;
}
return 0 if $name ne 'ftp' && ! $pam->authenticate( $name, $pass );
if(defined $user)
{
$user->jail if $chroot || $name eq 'ftp';
$user->drop_privileges;
}
});
$con->context->bad_authentication_delay(0);
1;
});
}
else
{
print STDERR "must specify at least one of --pam, --cred or --auth";
exit 2;
}
$server->start;
AnyEvent->condvar->recv;
__END__
=pod
=encoding UTF-8
=head1 NAME
aeftpd - FTP Server
=head1 VERSION
version 0.20
=head1 SYNOPSIS
% aeftpd [ --port port ]
[ --hostname hostname ]
[ --inet ]
[ --stderr path ]
[ --context context ]
[ --chroot ]
--pam service |
--cred user:pass |
--cred random |
--auth class [ --auth key=val ]
[ --verbose ]
% aeftpd --version
% aeftpd --help
=head1 DESCRIPTION
This program starts an FTP daemon using the perl library L.
=head1 OPTIONS
=head2 --port I
The TCP port to listen to.
=head2 --hostname I
The hostname or IP address to listen on.
=head2 --inet
Run in inet mode. By default C runs as a single process in standalone mode.
By using this option you can run C from C, C or similar daemon.
Here is a line for /etc/inetd.conf which was tested on Debian Wheezy, and may work
for you if your operating system supports PAM and you have L
installed.
ftp stream tcp nowait root /usr/sbin/tcpd aeftpd --inet --stderr /tmp/aeftp.log --pam login
=head2 --stderr I
Redirect stderr from the daemon to the file specified by the given path
=head2 --chroot
Use C to restrict the user to only his home directory once he has logged
in. This option requires the C function, which is supported by Perl on
most UNIX and UNIX like operating systems.
=head2 --cred [ I:I | random ]
Allow authentication with the given username and password. If you specify C
then a randomly generated username and password will be used.
=head2 --auth I
Specify a L class to use for authentication. You should NOT
include the Authen::Simple prefix when specifying the class (that is use
C instead of C).
=head2 --auth I=I
Specify an argument to pass into the chosen L object.
=head2 --pam I
Use PAM for authentication. This option is simply a shortcut. This:
% aeftpd --pam login
is the same as
% aeftpd --auth PAM --auth service=login
=head2 --verbose
Print all FTP commands and their responses to stderr.
=head2 --context I
Set the default context. The default is FSRW.
=head2 --version
Print out the L version to stdout and exit.
=head2 --help
Display the usage for this command.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/corpus/ 000755 000000 000000 00000000000 15123245460 015106 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/corpus/nlst/ 000755 000000 000000 00000000000 15123245460 016066 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/corpus/nlst/one.txt 000644 000000 000000 00000000000 15123245460 017376 0 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/corpus/nlst/three.txt 000644 000000 000000 00000000000 15123245460 017724 0 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/corpus/nlst/two.txt 000644 000000 000000 00000000000 15123245460 017426 0 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/dist.ini 000644 000000 000000 00000003257 15123245460 015246 0 ustar 00root root 000000 000000 name = AnyEvent-FTP
author = Graham Ollis
license = Perl_5
copyright_holder = Graham Ollis
copyright_year = 2017-2022
version = 0.20
[@Author::Plicease]
:version = 2.69
release_tests = 1
test2_v0 = 1
github_user = uperl
workflow = static
workflow = linux
diag_preamble = | $post_diag = sub {
diag_preamble = | use AnyEvent::FTP::Server::Context::FSRW;
diag_preamble = | diag "ls[] = ", $_ for AnyEvent::FTP::Server::Context::FSRW::_shared_cmd('ls');
diag_preamble = | BEGIN { eval 'use EV' }
diag_preamble = | diag 'AnyEvent::detect() = ', AnyEvent::detect();
diag_preamble = | };
[RemovePrereqs]
remove = strict
remove = warnings
remove = overload
remove = base
remove = bytes
remove = lib
remove = Exporter
; only used in release testing by t/lib.pl
remove = YAML
remove = YAML::XS
remove = NX::Lock
; comes with AnyEvent
remove = AnyEvent::Socket
remove = AnyEvent::Handle
; comes with Moo
remove = Moo::Role
; come with perl 5.10.1 (or better)
remove = File::Spec
remove = File::Temp
remove = Getopt::Long
remove = Carp
remove = Socket
remove = FindBin
remove = Pod::Usage
remove = Cwd
remove = File::Glob
; comes with Path::Class
remove = Path::Class::File
remove = Path::Class::Dir
; optional for testing
remove = Data::HexDump
remove = EV
[Prereqs]
perl = 5.010
PerlIO::eol = 0
Path::Class = 0
[MetaNoIndex]
directory = example
directory = tools
[InsertExample]
;[=inc::ServerTests]
[Author::Plicease::Upload]
cpan = 1
[Author::Plicease::Thanks]
current = Graham Ollis
contributor = Ryo Okamoto
contributor = Shlomi Fish
contributor = José Joaquín Atria
[PruneFiles]
filename = xt/author/pod_spelling_system.t
AnyEvent-FTP-0.20/example/ 000755 000000 000000 00000000000 15123245460 015226 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/blocking_retr.pl 000644 000000 000000 00000000651 15123245460 020411 0 ustar 00root root 000000 000000 use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new( passive => 1);
my $done = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->recv;
# use binary mode
$client->type('I')->recv;
# download the file directly into a filehandle
open my $fh, '>', 'perl-5.16.3.tar.gz';
$client->retr('perl-5.16.3.tar.gz', $fh)->recv;
AnyEvent-FTP-0.20/example/fget.pl 000644 000000 000000 00000005307 15123245460 016515 0 ustar 00root root 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $remote = shift;
unless(defined $remote)
{
say STDERR "usage: perl fget.pl [ -d | -p ] [ -a ] remote";
say STDERR " where remote is a URL for a file on an FTP server";
say STDERR " and local is a local filename (optional) where to transfer it to";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use active mode transfer";
exit 2;
}
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = $remote->clone;
$from->password(undef);
say "SRC: ", $from;
};
my @path = split /\//, $remote->path;
my $fn = pop @path;
if(-e $fn)
{
say STDERR "local file already exists";
exit 2;
}
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
$ftp->cwd(join '/', '', @path)->recv;
my $remote_size;
if($progress)
{
my $listing = $ftp->list($fn)->recv;
foreach my $class (qw( File::Listing File::Listing::Ftpcopy ))
{
my $parsed_listing = eval qq{ use $class; ${class}::parse_dir(\$listing->[0]) };
next if $@;
my ($name, $type, $size, $mtime, $mode) = @{ $parsed_listing->[0] };
$remote_size = $size;
last;
}
if(defined $remote_size)
{
}
else
{
say STDERR "could not determine size of remote file, cannot provide progress bar";
$progress = 0;
}
}
open my $fh, '>', $fn;
my $xfer = $ftp->retr($fn);
my $pb;
my $count = 0;
$xfer->on_open(sub {
my $handle = shift;
$pb = Term::ProgressBar->new({ count => $remote_size })
if $progress;
$handle->on_read(sub {
$handle->push_read(sub {
print $fh $_[0]{rbuf};
$pb->update($count += length($_[0]{rbuf})) if $pb;
$_[0]{rbuf} = '';
});
});
});
$xfer->recv;
close $fh;
$ftp->quit->recv;
AnyEvent-FTP-0.20/example/fls.pl 000644 000000 000000 00000001754 15123245460 016356 0 ustar 00root root 000000 000000 use strict;
use warnings;
use 5.010;
use URI;
use AnyEvent::FTP::Client;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
my $debug = 0;
my $method = 'nlst';
GetOptions(
'd' => \$debug,
'l' => sub { $method = 'list' },
);
my $ftp = AnyEvent::FTP::Client->new;
if($debug)
{
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments";
});
$ftp->on_each_response(sub {
my $res = shift;
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
});
}
my $uri = shift;
unless(defined $uri)
{
say STDERR "usage: perl fls.pl URL\n";
exit 2;
}
$uri = URI->new($uri);
unless($uri->scheme eq 'ftp')
{
say STDERR "only FTP URL accpeted";
exit 2;
}
unless(defined $uri->password)
{
$uri->password(prompt('p', 'Password: ', '', ''));
say '';
}
my $path = $uri->path;
$uri->path('');
$ftp->connect($uri);
say $_ for @{ $ftp->$method($path)->recv };
AnyEvent-FTP-0.20/example/fput.pl 000644 000000 000000 00000004512 15123245460 016543 0 ustar 00root root 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $local = shift;
my $remote = shift;
unless(defined $local && defined $remote)
{
say STDERR "usage: perl fput.pl [ -d | -p ] [ -a ] local remote";
say STDERR " where local is a local file";
say STDERR " and remote is a URL for a FTP server";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use an active transfer instead of passive";
exit 2;
}
$local = file($local);
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = URI::file->new_abs($local);
my $to = $remote->clone;
$to->password(undef);
say "SRC: ", $from;
say "DST: ", $to;
};
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
if(defined $remote->path)
{
$ftp->cwd($remote->path)->recv;
}
open my $fh, '<', $local;
binmode $fh;
my $buffer;
my $count;
my $pb;
my $xfer = $ftp->stor($local->basename);
$xfer->on_open(sub {
my $whandle = shift;
$pb = Term::ProgressBar->new({ count => -s $fh })
if $progress;
$whandle->on_drain(sub {
$pb->update($count) if $pb;
my $ret = read $fh, $buffer, 1024 * 512;
$count += $ret;
if($ret > 0)
{
$whandle->push_write($buffer);
}
else
{
$pb->update($count) if $pb;
$whandle->push_shutdown;
close $fh;
}
});
});
$xfer->recv;
$ftp->quit->recv;
AnyEvent-FTP-0.20/example/lib/ 000755 000000 000000 00000000000 15123245460 015774 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/lib/AnyEvent/ 000755 000000 000000 00000000000 15123245460 017525 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/lib/AnyEvent/FTP/ 000755 000000 000000 00000000000 15123245460 020156 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/lib/AnyEvent/FTP/Server/ 000755 000000 000000 00000000000 15123245460 021424 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/lib/AnyEvent/FTP/Server/Context/ 000755 000000 000000 00000000000 15123245460 023050 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/example/lib/AnyEvent/FTP/Server/Context/EchoContext.pm 000644 000000 000000 00000000517 15123245460 025634 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Server::Context::EchoContext;
use Moo;
extends 'AnyEvent::FTP::Server::Context';
with 'AnyEvent::FTP::Server::Role::Help';
# implement the non-existent echo command
sub help_echo { 'ECHO text' }
sub cmd_echo
{
my($self, $con, $req) = @_;
$con->send_response(211 => $req->args);
$self->done;
}
1;
AnyEvent-FTP-0.20/example/list.pl 000644 000000 000000 00000000625 15123245460 016541 0 ustar 00root root 000000 000000 use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new;
my $cv = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->cb(sub {
# execute LIST command and print results to stdout
$client->list->cb(sub {
my $list = shift->recv;
print "$_\n" for @$list;
$cv->send;
});
});
$cv->recv;
AnyEvent-FTP-0.20/example/non_blocking_retr.pl 000644 000000 000000 00000001350 15123245460 021260 0 ustar 00root root 000000 000000 use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new( passive => 1);
my $done = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->cb(sub {
# use binary mode
$client->type('I')->cb(sub {
# download the file directly into a filehandle
open my $fh, '>', 'perl-5.16.3.tar.gz';
$client->retr('perl-5.16.3.tar.gz', $fh)->cb(sub {
# notify anyone listening to $done that
# the transfer is complete
$done->send;
});
});
});
# receive the done message once the transfer is
# complete. In real code you'd probably not
# want to do this because your event loop may
# not support blocking.
$done->recv;
AnyEvent-FTP-0.20/inc/ 000755 000000 000000 00000000000 15123245460 014344 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/inc/ServerTests.pm 000644 000000 000000 00000003702 15123245460 017175 0 ustar 00root root 000000 000000 package inc::ServerTests;
use Moose;
use namespace::autoclean;
use 5.010;
use Path::Class qw( file dir );
use YAML qw( LoadFile DumpFile );
use File::Glob qw( bsd_glob );
with 'Dist::Zilla::Role::TestRunner';
sub test
{
my($self, $target) = @_;
my $test_root = dir('.')->absolute;
my @services = do {
open my $fh, '<', '/etc/services';
map { [split /\s+/]->[0] } grep /^(..)?ftp\s/, <$fh>;
};
foreach my $service (@services)
{
my $dir = $test_root->subdir('t', 'server', $service);
$dir->mkpath(0,0700);
my $old = $test_root->file('t', 'lib.pl');
my $new = $dir->file('lib.pl');
symlink $old, $new;
$old = file( bsd_glob '~/etc/localhost/yml');
$new = $dir->file('config.yml');
my $config = LoadFile($old);
$config->{port} = $service;
DumpFile($new, $config);
}
my @remotes;
foreach my $remote_config (grep { $_->basename =~ /\.yml$/ } dir(bsd_glob '~/etc')->children)
{
next if $remote_config->basename eq 'localhost.yml';
#$self->zilla->log($remote_config->basename);
my $name = $remote_config->basename;
$name =~ s/\.yml$//;
push @remotes, $name;
my $dir = $test_root->subdir('t','server',$name);
$dir->mkpath(0,0700);
my $old = $test_root->file('t', 'lib.pl');
my $new = $dir->file('lib.pl');
symlink $old, $new;
$old = $remote_config;
$new = $dir->file('config.yml');
my $config = LoadFile($old);
DumpFile($new, $config);
}
foreach my $test_file (grep { $_->basename =~ /^client_/ } sort { $a->basename cmp $b->basename } $test_root->subdir('t')->children)
{
foreach my $service (@services, @remotes)
{
my $link = $test_root->file('t', 'server', $service, $test_file->basename);
symlink $test_file, $link;
}
}
local $ENV{AEF_PORT} = 'from_config';
system 'prove', '-br', ($ENV{AEF_JOBS} ? ('-j' => $ENV{AEF_JOBS}, '-s') : ()), 't/server';
$self->log_fatal('server test failure') unless $? == 0;
}
1;
AnyEvent-FTP-0.20/lib/ 000755 000000 000000 00000000000 15123245460 014341 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/ 000755 000000 000000 00000000000 15123245460 016072 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP.pm 000644 000000 000000 00000005655 15123245460 017074 0 ustar 00root root 000000 000000 package AnyEvent::FTP;
use strict;
use warnings;
use 5.010;
# ABSTRACT: Simple asynchronous FTP client and server
our $VERSION = '0.20'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP - Simple asynchronous FTP client and server
=head1 VERSION
version 0.20
=head1 SYNOPSIS
# For the client
use AnyEvent::FTP::Client;
# For the server
use AnyEvent::FTP::Server;
=head1 DESCRIPTION
This distribution provides client and server implementations for
File Transfer Protocol (FTP) in an AnyEvent environment. For the
specific interfaces, see L and L
for details.
Before each release, L is tested against these FTP servers
using the C tests that come with this distribution:
=over 4
=item Proftpd
=item wu-ftpd
=item L
=item vsftpd
=item Pure-FTPd
=item bftpd
=item L
=back
The client code is also tested less frequently against these FTP servers:
=over 4
=item NcFTPd
=item Microsoft IIS
=back
It used to also be tested against the VMS ftp server, so it was verified to
work with it, at least at one point. However, I no longer have access to that
server.
=head1 BUNDLED FILES
This distribution comes bundled with C from the old
L project.
This is only used on C if this command is not found in
the path, as it is frequently not available on that platform
The Perl implementation of C
was written by Mark Leighton Fisher of Thomson Consumer Electronics,
I.
That program is free and open software. You may use, modify,
distribute, and sell it program (and any modified variants) in any
way you wish, provided you do not restrict others from doing the same.
=head1 SEE ALSO
=over 4
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=item *
L
=back
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/ 000755 000000 000000 00000000000 15123245460 016523 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client.pm 000644 000000 000000 00000071325 15123245460 020307 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client;
use 5.010;
use Moo;
use AnyEvent;
use AnyEvent::Socket qw( tcp_connect );
use AnyEvent::Handle;
use Carp qw( croak );
use Socket qw( unpack_sockaddr_in inet_ntoa );
# ABSTRACT: Simple asynchronous ftp client
our $VERSION = '0.20'; # VERSION
with 'AnyEvent::FTP::Role::Event';
with 'AnyEvent::FTP::Client::Role::ResponseBuffer';
with 'AnyEvent::FTP::Client::Role::RequestBuffer';
__PACKAGE__->define_events(qw( error close send greeting ));
has _connected => (
is => 'rw',
default => sub { 0 },
init_arg => undef,
);
has timeout => (
is => 'rw',
default => sub { 30 },
);
has passive => (
is => 'ro',
default => sub { 1 },
);
foreach my $xfer (qw( Store Fetch List ))
{
my $cb = sub {
return shift->passive
? 'AnyEvent::FTP::Client::Transfer::Passive::'.$xfer
: 'AnyEvent::FTP::Client::Transfer::Active::'.$xfer;
};
has '_'.lc($xfer) => ( is => 'ro', lazy => 1, default => $cb, init_arg => undef ),
}
sub BUILD
{
my($self) = @_;
$self->on_error(sub { warn shift });
$self->on_close(sub {
$self->clear_command;
$self->_connected(0);
delete $self->{handle};
});
require ($self->passive
? 'AnyEvent/FTP/Client/Transfer/Passive.pm'
: 'AnyEvent/FTP/Client/Transfer/Active.pm');
return;
}
sub connect
{
my($self, $host, $port) = @_;
if($host =~ /^ftp:/)
{
require URI;
$host = URI->new($host);
}
my $uri;
if(ref($host) && eval { $host->isa('URI') })
{
$uri = $host;
$host = $uri->host;
$port = $uri->port;
}
else
{
$port //= 21;
}
croak "Tried to reconnect while connected" if $self->_connected;
my $cv = AnyEvent->condvar;
$self->_connected(1);
tcp_connect $host, $port, sub {
my($fh) = @_;
unless($fh)
{
$cv->croak("unable to connect: $!");
$self->_connected(0);
$self->clear_command;
return;
}
# Get the IP address we are sending from for when
# we use the PORT command (passive=0).
$self->{my_ip} = do {
my($port, $addr) = unpack_sockaddr_in getsockname $fh;
inet_ntoa $addr;
};
$self->{handle} = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
$_[0]->destroy;
$self->emit('error', $msg);
$self->emit('close');
},
on_eof => sub {
$self->{handle}->destroy;
$self->emit('close');
},
);
$self->on_next_response(sub {
my $res = shift;
return $cv->croak($res) unless $res->is_success;
$self->emit(greeting => $res);
if(defined $uri)
{
my @start_commands = (
[USER => $uri->user],
[PASS => $uri->password],
);
push @start_commands, [CWD => $uri->path] if $uri->path ne '';
$self->unshift_command(@start_commands, $cv);
}
else
{
$cv->send($res);
$self->pop_command;
}
});
$self->{handle}->on_read(sub {
$self->{handle}->push_read( line => sub {
my($handle, $line) = @_;
$self->process_message_line($line);
});
});
}, sub {
$self->timeout;
};
return $cv;
}
sub login
{
my($self, $user, $pass) = @_;
$self->push_command(
[ USER => $user ],
[ PASS => $pass ]
);
}
sub retr
{
my($self, $filename, $local) = (shift, shift, shift);
my $args = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
$self->_fetch->new({
command => [ RETR => $filename ],
local => $local,
client => $self,
restart => $args->{restart},
});
}
sub stor
{
my($self, $filename, $local) = @_;
$self->_store->new(
command => [STOR => $filename],
local => $local,
client => $self,
);
}
sub stou
{
my($self, $filename, $local) = @_;
my $xfer;
my $cb = sub {
my $name = shift->get_file;
$xfer->{remote_name} = $name if defined $name;
return;
};
$xfer = $self->_store->new(
command => [STOU => $filename, $cb],
local => $local,
client => $self,
);
}
# for this to work under ProFTPd: AllowStoreRestart off
sub appe
{
my($self, $filename, $local) = @_;
$self->_store->new(
command => [APPE => $filename],
local => $local,
client => $self,
);
}
sub list
{
my($self, $location, $verb) = @_;
$verb //= 'LIST';
my @lines;
my $cv = AnyEvent->condvar;
$self->_list->new(
command => [ $verb => $location ],
local => \@lines,
client => $self,
)->cb(sub {
my $res = eval { shift->recv };
$cv->croak($@) if $@;
$cv->send(\@lines);
});
$cv;
}
sub nlst
{
my($self, $location) = @_;
$self->list($location, 'NLST');
}
sub rename
{
my($self, $from, $to) = @_;
$self->push_command(
[ RNFR => $from ],
[ RNTO => $to ],
);
}
sub pwd
{
my($self) = @_;
my $cv = AnyEvent->condvar;
$self->push_command(['PWD'])->cb(sub {
my $res = eval { shift->recv } // $@;
my $dir = $res->get_dir;
if($dir) { $cv->send($dir) }
else { $cv->croak($res) }
});
$cv;
}
sub size
{
my($self, $path) = @_;
my $cv = AnyEvent->condvar;
$self->push_command(['SIZE', $path])->cb(sub {
my $res = eval { shift->recv };
if(my $error = $@)
{ $cv->croak($error) }
else
{ $cv->send($res->message->[0]) }
});
$cv;
}
(eval sprintf('sub %s { shift->push_command([ %s => @_])};1', lc $_, $_)) // die $@
for qw( CWD CDUP NOOP ALLO SYST TYPE STRU MODE REST MKD RMD STAT HELP DELE RNFR RNTO USER PASS ACCT MDTM );
sub quit
{
my($self) = @_;
my $cv = AnyEvent->condvar;
my $res;
$self->push_command(['QUIT'])->cb(sub {
$res = eval { shift->recv } // $@;
});
my $save = $self->{event}->{close};
$self->{event}->{close} = [ sub {
if(defined $res && $res->is_success)
{ $cv->send($res) }
elsif(defined $res)
{ $cv->croak($res) }
else
{ $cv->croak("did not receive QUIT response from server") }
$_->() for @$save;
$self->{event}->{close} = $save;
} ];
return $cv;
}
sub site
{
require AnyEvent::FTP::Client::Site;
AnyEvent::FTP::Client::Site->new(shift);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client - Simple asynchronous ftp client
=head1 VERSION
version 0.20
=head1 SYNOPSIS
Non blocking example:
use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new( passive => 1);
my $done = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->cb(sub {
# use binary mode
$client->type('I')->cb(sub {
# download the file directly into a filehandle
open my $fh, '>', 'perl-5.16.3.tar.gz';
$client->retr('perl-5.16.3.tar.gz', $fh)->cb(sub {
# notify anyone listening to $done that
# the transfer is complete
$done->send;
});
});
});
# receive the done message once the transfer is
# complete. In real code you'd probably not
# want to do this because your event loop may
# not support blocking.
$done->recv;
Same, but using recv to wait for each command to complete (not supported in all event loops):
use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new( passive => 1);
my $done = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->recv;
# use binary mode
$client->type('I')->recv;
# download the file directly into a filehandle
open my $fh, '>', 'perl-5.16.3.tar.gz';
$client->retr('perl-5.16.3.tar.gz', $fh)->recv;
=head1 DESCRIPTION
This class provides an AnyEvent client interface to the File
Transfer Protocol (FTP).
=head1 ROLES
This class consumes these roles:
=over 4
=item *
L
=item *
L
=item *
L
=back
=head1 EVENTS
For details on the event interface see L.
=head2 send
This event gets fired on every command sent to the remote server. Keep
in mind that some methods of L may make multiple FTP commands
in order to implement their functionality (for example, C, C, etc).
One use of this event is to print out commands as they are sent for debugging:
$client->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
# hide passwords
$arguments = 'XXXX' if $cmd =~ /^pass$/i;
say "CLIENT: $cmd $arguments";
});
=head2 error
This event is emitted when there is a network error with the remote server.
It passes in a string which describes in human readable description of what
went wrong.
$client->on_error(sub {
my($message) = @_;
warn "network error: $message";
});
=head2 close
This event is emitted when the connection with the remote server is closed,
either due to an error, or when you send the FTP C command using the
C method.
$client->on_close(sub {
# called when connection closed
});
=head2 greeting
This event gets fired on the first response returned from the server. This
is usually a C<220> message which may or may not reveal the server software.
$client->on_greeting(sub {
# $res is a AnyEvent::FTP::Client::Response
my($res) = @_;
if($res->message->[0] =~ /ProFTPD/)
{
# detected a ProFTPD server
}
});
=head2 each_response
This event gets fired for each response returned from the server. This can
be useful for printing the responses for debugging.
$client->on_each_response(sub {
# $res isa AnyEvent::FTP::Client::Response
my($res) = @_;
print "SERVER: $res\n";
});
=head2 next_response
Works just like C event, but only gets fired for the next response
received.
=head1 ATTRIBUTES
=head2 timeout
Timeout for the initial connection to the FTP server. The default
is 30.
=head2 passive
If set to true (the default) then data will be transferred using the
passive (PASV) command, meaning the server will open a port for the
client to connect to. If set to false then data will be transferred
using data port (PORT) command, meaning the client will open a port
for the server to send to.
=head1 METHODS
Unless otherwise specified, these methods will return an AnyEvent condition variable
(AnyEvent->condvar) or an object that implements its interface (methods C, C).
On success the C will be used on the condition variable, on failure C will be
used instead. Unless otherwise specified the object sent (for both success and failure)
will be an instance of L.
As an example, here is a fairly thorough handling of a response to the standard FTP C
command:
$client->help->cb(sub {
my $res = eval { shift->recv };
if(my $error = $@)
{
# $error isa AnyEvent::FTP::Client::Response with a 4xx or 5xx
# code
my $code = $error->code;
# the message component is always a list ref, even if
# the response had just one message line
my @msg = @{ $error->message };
# $error is stringified into something human readable when
# it is streated as a string
warn "error trying FTP HELP command: $error";
}
else
{
# $res isa AnyEvent::FTP::Client::Response with a 2xx or 3xx
# code
my $code = $res->code;
# the message component is always a list ref, even if
# the response had just one message line
my @msg = @{ $res->message };
# $res is stringified into something human readable when
# it is streated as a string
print "help message: $res";
}
});
=head2 connect
$client->connect(@remote_host);
Connect to the FTP server. The remote host may be specified in one
of these ways:
=over 4
=item $client-Econnect($host, [ $port ])
The host and port of the remote server. If not specified, the default FTP port will be used (21).
=item $client-Econnect($uri)
The URI of the remote FTP server. C<$uri> must be either an instance of L with the C
scheme, or a string with an FTP URL.
If you use this method to connect to the FTP server, connect will also attempt to login with
the username and password specified in the URL (or anonymous FTP if no credentials are
specified).
If there is a path included in the URL, then connect will also do a C so that you start
in that directory.
=back
=head2 login
$client->login($user, $pass);
Attempt to login to the FTP server which has already been connected to using
the C method. This is not necessary if you used C with a URI.
=head2 retr
$client->retr($filename, $local, %options)
Retrieve the given file from the server and use C<$local> to store the results.
Returns an instance of L, which supports the
AnyEvent condition variable interface (that is it has C and C methods).
Its callback will be called when the transfer is complete.
C<$local> may be one of
=over 4
=item scalar reference
The contents of the file will be stored in the scalar referred to by the reference.
my $local;
$client->retr('foo.txt', \$local);
=item file handle
The content of the remote file will be written into the local file handle as it is
received
open my $fh, '>', 'foo.txt';
binmode $fh;
$client->retr('foo.txt', $fh);
=item the name of the local file
If C<$local> is just a regular non reference scalar, then it will be treated as the
local filename, which will be created and written to as data is received from the
server.
$client->retr('foo.txt', 'foo.txt');
=item subroutine reference / callback reference
The contents of the file will be passed to the callback as they are received.
$client->retr('foo.txt', sub {
my ($data) = @_;
# Do something with $data
},
);
=back
In order to resume a transfer, you need to include the C option after the
C<$local> argument. Here is an example:
# assumes foo.txt (partial download) exists in the current
# loacal directory and foo.txt (full file) exists in the
# current remote directory.
my $filename = 'foo.txt';
open my $fh, '>>', $filename;
binmode $fh;
$client->retr($filename, $fh, restart => tell $fh);
=head2 stor
$client->stor($filename, $local);
Send a file to the server with the given remote filename (C<$filename>)
and using C<$local> as a source.
Returns an instance of L, which supports the
AnyEvent condition variable interface (that is it has C and C methods).
Its callback will be called when the transfer is complete.
C<$local> may be one of
=over 4
=item scalar reference
The contents of the file will be retrieved from the scalar referred to by the reference.
my $local = 'some data for foo.txt';
$client->stor('foo.txt', \$local);
=item file handle
The contents of the file will be read from the file handle.
open my $fh, '<', 'foo.txt';
binmode $fh;
$client->stor('foo.txt', $fh);
=item the name of the local file
If C<$local> is just a regular non reference scalar, then it will be treated as the
local filename, which will be opened and read from in order to create the file on
the server.
$client->stor('foo.txt', 'foo.txt');
=back
=head2 stou
$client->stou($filename, $local)
Works exactly like the C method, except use the FTP C command instead of
C. Since the remote filename is optional for C you may pass in C
as the remote filename. You can get the remote filename after the fact using the
C method.
my $xfer;
$xfer = $client->stou(undef, $local)->cb(sub {
my $remote_filename = $xfer->remote_name;
});
=head2 appe
$client->appe($filename, $local);
Works exactly like the C method, except use the FTP C command instead of
C. This method will append C<$local> to the remote file. One way to resume an
upload to the remote FTP server would be to open the local file, determine the remote
file's size and seek to that position in the local file and use the C method
with C<$local> as that file handle, as in this example:
# assume that foo.txt is in the current local dir
# and the remote local dir
my $filename = "foo.txt";
$client->size($filename)->cb(sub {
my $size = shift->recv;
open my $fh, '<', $filename;
binmode $fh;
seek $fh, $size, 0;
$client->appe($filename, $fh);
});
Note that the C command is an extension to FTP, and may not be available on all
servers.
=head2 list
$client->list($location)
Execute the FTP C command. The results will be sent as a list reference
(instead of a L object) to the returned condition
variable.
use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new;
my $cv = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->cb(sub {
# execute LIST command and print results to stdout
$client->list->cb(sub {
my $list = shift->recv;
print "$_\n" for @$list;
$cv->send;
});
});
$cv->recv;
=head2 nlst
$client->nlst($location);
Works exactly like the C method, except the FTP C command is used.
The main difference is that this method returns filenames only.
=head2 rename
$client->rename($from, $to);
This method renames the remote file from C<$from> to C<$to>.
It uses the FTP C and C commands and thus this:
my $cv = $client->rename($from, $to);
is a short cut for:
my $cv;
$client->rnfr($from)->cb(sub {
$cv = $client->rnto($to);
});
Although C<$cv> may not be defined right away, so use the second with care.
=head2 cwd
$client->cwd( $dir );
Change to the given directory on the remote server.
=head2 pwd
$client->pwd;
Gets the current working directory on the remote server. This gets just the string
representing the directory path instead of a L object.
=head2 cdup
$client->cdup
Change to the parent directory on the remote server. This is usually the same
as
$client->cwd('..');
=head2 type
$client->type
Set the transfer type. You almost always want to set to binary mode immediately
after logging on:
$client->type('I');
=head2 rest
$client->rest
This command is used to resume a download transfer. Typically you would
not use this method directly, but instead add a C option on
the C method instead.
=head2 mkd
$client->mkd( $path );
Create a directory on the remote server.
=head2 rmd
$client->rmd( $path );
Remove a directory on the remote server.
=head2 help
$client->help;
Gets a list of commands understood by the server.
The actual format depends on the server.
=head2 dele
$client->dele( $path );
Delete the file on the remote server.
=head2 rnfr
$client->rnfr;
Specify the old name for renaming a file. See C method for a shortcut.
=head2 rnto
$client->rnto;
Specify the new name for renaming a file. See C method for a shortcut.
=head2 noop
$client->noop;
Don't do anything. The server will send an OK reply.
=head2 allo
$client->allo( $size );
Send the FTP C command. Is not used by modern FTP servers. See RFC959 for details.
=head2 syst
$client->syst;
Returns the type of operating system used by the server.
=head2 stru
$client->stru;
Specify the file structure mode. This is not used by modern FTP servers. See RFC959 for details.
=head2 mode
$client->mode
Specify the transfer mode. This is not used by modern FTP servers. See RFC959 for details.
=head2 stat
$client->stat;
$client->stat($path);
Get information about a file or directory on the remote server. The actual format is totally
server dependent.
=head2 user
$client->user( $username );
Specify the user to login as. See C or C methods for a shortcut.
=head2 pass
$client->pass( $pass );
Specify the password to use for login. See C or C methods for a shortcut.
=head2 acct
$client->acct( $acct );
Specify user's account. This is sometimes used for authentication and authorization when you login
to some servers, but is seldom used today in practice. See RFC959 for details.
=head2 size
$client->size( $path );
Get the size of the remote file specified by C<$path>. This is an extension to the FTP
standard specified in RFC3659, and may not be implemented by older (or even newer)
servers.
Send the size of the file on success, instead of the response object.
=head2 mdtm
$client->mdtm( $path );
Get the modification time of the remote file specified by C<$path>. This is an extension to the FTP standard
specified in RFC3659, and may not be implemented by older (or even newer) servers.
=head2 quit
$client->quit;
Send the FTP C command and close the connection to the remote server.
=head2 site
$client->site;
The C method provides an interface to site specific FTP commands. Many
FTP servers will support an extended set of commands using the standard FTP
C command. This command will not check to see if the site commands are
supported by the remote server, so it is up to you to determine if you can
really use these interfaces yourself.
=over 4
=item $client-Esite-Emicrosoft
For commands specific to Microsoft's IIS FTP server.
See L.
=item $client-Esite-Enet_ftp_server
For commands specific to L.
See L.
=item $client-Esite-Eproftpd
For commands specific to proftpd.
See L.
=back
=head1 EXAMPLES
Here are some longer examples. They are also included with the
L distribution in its C directory.
=head2 fget.pl
Given a URL to a file, this script will fetch the file and store it
on your local machine. If you use the C<-d> option you can see the
FTP commands and their responses as they happen.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $remote = shift;
unless(defined $remote)
{
say STDERR "usage: perl fget.pl [ -d | -p ] [ -a ] remote";
say STDERR " where remote is a URL for a file on an FTP server";
say STDERR " and local is a local filename (optional) where to transfer it to";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use active mode transfer";
exit 2;
}
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = $remote->clone;
$from->password(undef);
say "SRC: ", $from;
};
my @path = split /\//, $remote->path;
my $fn = pop @path;
if(-e $fn)
{
say STDERR "local file already exists";
exit 2;
}
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
$ftp->cwd(join '/', '', @path)->recv;
my $remote_size;
if($progress)
{
my $listing = $ftp->list($fn)->recv;
foreach my $class (qw( File::Listing File::Listing::Ftpcopy ))
{
my $parsed_listing = eval qq{ use $class; ${class}::parse_dir(\$listing->[0]) };
next if $@;
my ($name, $type, $size, $mtime, $mode) = @{ $parsed_listing->[0] };
$remote_size = $size;
last;
}
if(defined $remote_size)
{
}
else
{
say STDERR "could not determine size of remote file, cannot provide progress bar";
$progress = 0;
}
}
open my $fh, '>', $fn;
my $xfer = $ftp->retr($fn);
my $pb;
my $count = 0;
$xfer->on_open(sub {
my $handle = shift;
$pb = Term::ProgressBar->new({ count => $remote_size })
if $progress;
$handle->on_read(sub {
$handle->push_read(sub {
print $fh $_[0]{rbuf};
$pb->update($count += length($_[0]{rbuf})) if $pb;
$_[0]{rbuf} = '';
});
});
});
$xfer->recv;
close $fh;
$ftp->quit->recv;
=head2 fls.pl
Here is a similar example, which does a directory listing on a FTP
directory URL. If you use the C<-d> option to see the FTP commands
and their responses as they happen. You can use the C<-l> option
to see the long form of the file listing.
use strict;
use warnings;
use 5.010;
use URI;
use AnyEvent::FTP::Client;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
my $debug = 0;
my $method = 'nlst';
GetOptions(
'd' => \$debug,
'l' => sub { $method = 'list' },
);
my $ftp = AnyEvent::FTP::Client->new;
if($debug)
{
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments";
});
$ftp->on_each_response(sub {
my $res = shift;
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
});
}
my $uri = shift;
unless(defined $uri)
{
say STDERR "usage: perl fls.pl URL\n";
exit 2;
}
$uri = URI->new($uri);
unless($uri->scheme eq 'ftp')
{
say STDERR "only FTP URL accpeted";
exit 2;
}
unless(defined $uri->password)
{
$uri->password(prompt('p', 'Password: ', '', ''));
say '';
}
my $path = $uri->path;
$uri->path('');
$ftp->connect($uri);
say $_ for @{ $ftp->$method($path)->recv };
=head2 fput.pl
This script uploads a local file to the remote given a local filename
and a remote FTP URL.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $local = shift;
my $remote = shift;
unless(defined $local && defined $remote)
{
say STDERR "usage: perl fput.pl [ -d | -p ] [ -a ] local remote";
say STDERR " where local is a local file";
say STDERR " and remote is a URL for a FTP server";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use an active transfer instead of passive";
exit 2;
}
$local = file($local);
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = URI::file->new_abs($local);
my $to = $remote->clone;
$to->password(undef);
say "SRC: ", $from;
say "DST: ", $to;
};
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
if(defined $remote->path)
{
$ftp->cwd($remote->path)->recv;
}
open my $fh, '<', $local;
binmode $fh;
my $buffer;
my $count;
my $pb;
my $xfer = $ftp->stor($local->basename);
$xfer->on_open(sub {
my $whandle = shift;
$pb = Term::ProgressBar->new({ count => -s $fh })
if $progress;
$whandle->on_drain(sub {
$pb->update($count) if $pb;
my $ret = read $fh, $buffer, 1024 * 512;
$count += $ret;
if($ret > 0)
{
$whandle->push_write($buffer);
}
else
{
$pb->update($count) if $pb;
$whandle->push_shutdown;
close $fh;
}
});
});
$xfer->recv;
$ftp->quit->recv;
=head1 SEE ALSO
=over 4
=item *
L
=item *
L
=back
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/ 000755 000000 000000 00000000000 15123245460 017741 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Response.pm 000644 000000 000000 00000003306 15123245460 022077 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Response;
use strict;
use warnings;
use 5.010;
use base qw( AnyEvent::FTP::Response );
# ABSTRACT: Response class for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
sub get_address_and_port
{
return ("$1.$2.$3.$4", $5*256+$6) if shift->{message}->[0] =~ /\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)/;
return;
}
sub get_dir
{
if(shift->{message}->[0] =~ /^"(.*)"/)
{
my $dir = $1;
$dir =~ s/""/"/;
return $dir;
}
return;
}
sub get_file
{
return shift->{message}->[0] =~ /^FILE: (.*)/i ? $1 : ();
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Response - Response class for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 DESCRIPTION
Instances of this class get sent to condition variables returned by
commands in L.
=head1 SUPER CLASS
L
=head1 METHODS
=head2 get_address_and_port
my($ip, $port) = $res->get_address_and_port
This method is used to parse the response to the C command to extract the IP address
and port number.
=head2 get_dir
my $dir = $res->get_dir
This method is used to extract the path from a response to the C command.
It returns the path as a simple string.
=head2 get_file
my $filename = $res->get_file;
Returns the filename from a response to the C command.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/ 000755 000000 000000 00000000000 15123245460 020642 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/FetchTransfer.pm 000644 000000 000000 00000003424 15123245460 023741 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Role::FetchTransfer;
use strict;
use warnings;
use 5.010;
use Moo::Role;
# ABSTRACT: Fetch transfer interface for AnyEvent::FTP objects
our $VERSION = '0.20'; # VERSION
sub xfer
{
my($self, $fh, $local) = @_;
my $handle = $self->handle($fh);
return unless defined $local;
$handle->on_read(sub {
$handle->push_read(sub {
$local->($_[0]{rbuf});
$_[0]{rbuf} = '';
});
});
}
sub convert_local
{
my($self, $local) = @_;
return unless defined $local;
return $local if ref($local) eq 'CODE';
if(ref($local) eq 'SCALAR')
{
return sub {
$$local .= shift;
};
}
elsif(ref($local) eq 'GLOB')
{
return sub {
print $local shift;
};
}
elsif(ref($local) eq '')
{
open my $fh, '>', $local;
$self->on_close(sub { close $fh });
return sub {
print $fh shift;
};
}
else
{
die 'unimplemented: ' . ref $local;
}
}
sub push_command
{
my $self = shift;
my $cv = $self->{client}->push_command(
@_,
);
$cv->cb(sub {
eval { $cv->recv };
my $err = $@;
$self->{cv}->croak($err) if $err;
});
$self->on_eof(sub {
$cv->cb(sub {
my $res = eval { $cv->recv };
$self->{cv}->send($res) unless $@;
});
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Role::FetchTransfer - Fetch transfer interface for AnyEvent::FTP objects
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/ListTransfer.pm 000644 000000 000000 00000002550 15123245460 023622 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Role::ListTransfer;
use strict;
use warnings;
use 5.010;
use Moo::Role;
# ABSTRACT: Fetch transfer interface for AnyEvent::FTP objects
our $VERSION = '0.20'; # VERSION
sub xfer
{
my($self, $fh, $local) = @_;
my $handle = $self->handle($fh);
$handle->on_read(sub {
$handle->push_read(line => sub {
my($handle, $line) = @_;
$line =~ s/\015?\012//g;
push @{ $local }, $line;
});
});
}
sub convert_local
{
my($self, $local) = @_;
return $local;
}
sub push_command
{
my $self = shift;
my $cv = $self->{client}->push_command(
@_,
);
$cv->cb(sub {
eval { $cv->recv };
my $err = $@;
$self->{cv}->croak($err) if $err;
});
$self->on_eof(sub {
$cv->cb(sub {
my $res = eval { $cv->recv };
$self->{cv}->send($res) unless $@;
});
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Role::ListTransfer - Fetch transfer interface for AnyEvent::FTP objects
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/RequestBuffer.pm 000644 000000 000000 00000005451 15123245460 023767 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Role::RequestBuffer;
use strict;
use warnings;
use 5.010;
use Moo::Role;
use AnyEvent;
# ABSTRACT: Request buffer role for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
has request_buffer => (
is => 'ro',
default => sub { [] },
);
sub push_command
{
my $cv;
$cv = pop if (ref $_[-1]) eq 'AnyEvent::CondVar';
$cv //= AnyEvent->condvar;
my($self, @commands) = @_;
push @{ $self->request_buffer }, { cmd => \@commands, cv => $cv };
$self->pop_command;
$cv;
}
sub unshift_command
{
my $cv;
$cv = pop if (ref $_[-1]) eq 'AnyEvent::CondVar';
$cv //= AnyEvent->condvar;
my($self, @commands) = @_;
unshift @{ $self->request_buffer }, { cmd => \@commands, cv => $cv };
$self->pop_command;
$cv;
}
sub pop_command
{
my($self) = @_;
$self->{ready} //= 1;
return $self unless defined $self->{handle};
unless(@{ $self->request_buffer } > 0)
{
$self->{ready} = 1;
return $self;
}
return unless $self->{ready};
my($cmd, $args, $cb) = @{ shift @{ $self->request_buffer->[0]->{cmd} } };
my $line = defined $args ? join(' ', $cmd, $args) : $cmd;
my $handler;
$handler = sub {
my $res = shift;
if(defined $cb)
{
my $error = $cb->($res);
if(defined $error)
{
my $batch = shift @{ $self->request_buffer };
$batch->{cv}->croak($error);
return;
}
}
if($res->is_preliminary)
{
$self->on_next_response($handler);
}
else
{
$self->{ready} = 1;
if($res->is_success)
{
if(@{ $self->request_buffer->[0]->{cmd} } > 0)
{
$self->pop_command;
}
else
{
my $batch = shift @{ $self->request_buffer };
$batch->{cv}->send($res);
$self->pop_command;
}
}
else
{
my $batch = shift @{ $self->request_buffer };
$batch->{cv}->croak($res);
$self->pop_command;
}
}
};
$self->on_next_response($handler);
$self->{ready} = 0;
$self->emit('send', $cmd, $args);
$self->{handle}->push_write("$line\015\012");
$self;
}
sub clear_command
{
my($self) = @_;
@{ $self->request_buffer } = ();
$self->{ready} = 1;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Role::RequestBuffer - Request buffer role for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 DESCRIPTION
Used internally by L.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/ResponseBuffer.pm 000644 000000 000000 00000003447 15123245460 024140 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Role::ResponseBuffer;
use strict;
use warnings;
use 5.010;
use Moo::Role;
use AnyEvent::FTP::Client::Response;
# ABSTRACT: Response buffer role for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
sub on_next_response
{
my($self, $cb) = @_;
push @{ $self->{response_buffer}->{once} }, $cb;
}
sub on_each_response
{
my($self, $cb) = @_;
push @{ $self->{response_buffer}->{each} }, $cb;
}
sub process_message_line
{
my($self, $line) = @_;
$line =~ s/\015?\012//g;
if($line =~ s/^(\d\d\d)([- ])//)
{
$self->{response_buffer}->{code} //= $1;
push @{ $self->{response_buffer}->{message} }, $line;
if($2 eq ' ')
{
my $response = AnyEvent::FTP::Client::Response->new(
$self->{response_buffer}->{code},
$self->{response_buffer}->{message},
);
delete $self->{response_buffer}->{$_} for qw( code message );
my $once = delete $self->{response_buffer}->{once};
$_->($response)
for @{ $self->{response_buffer}->{each} }, @{ $once };
}
}
elsif(@{ $self->{response_buffer}->{message} } > 0)
{
push @{ $self->{response_buffer}->{message} }, $line;
}
else
{
warn "bad message: $line";
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Role::ResponseBuffer - Response buffer role for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 DESCRIPTION
Used internally by L.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Role/StoreTransfer.pm 000644 000000 000000 00000003371 15123245460 024005 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Role::StoreTransfer;
use strict;
use warnings;
use 5.010;
use Moo::Role;
# ABSTRACT: Store transfer interface for AnyEvent::FTP objects
our $VERSION = '0.20'; # VERSION
sub xfer
{
my($self, $fh, $local) = @_;
my $handle = $self->handle($fh);
return unless defined $local;
$handle->on_drain(sub {
my $data = $local->();
if(defined $data)
{
$handle->push_write($data);
}
else
{
$handle->push_shutdown;
$handle->destroy;
}
});
}
sub convert_local
{
my($self, $local) = @_;
return unless defined $local;
return $local if ref($local) eq 'CODE';
if(ref($local) eq '')
{
open my $fh, '<', $local;
$self->on_close(sub { close $fh });
return sub {
local $/;
<$fh>;
};
}
elsif(ref($local) eq 'SCALAR')
{
my $buffer = $$local;
return sub {
my $tmp = $buffer;
undef $buffer;
$tmp;
};
}
elsif(ref($local) eq 'GLOB')
{
sub {
# TODO: for big files, maybe
# break this up into batches
local $/;
<$local>;
};
}
else
{
die 'bad local type';
}
}
sub push_command
{
my $self = shift;
$self->{client}->push_command(
@_,
$self->cv,
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Role::StoreTransfer - Store transfer interface for AnyEvent::FTP objects
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site.pm 000644 000000 000000 00000002063 15123245460 021204 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Site;
use strict;
use warnings;
use 5.010;
# ABSTRACT: Dispatcher for site specific ftp commands
our $VERSION = '0.20'; # VERSION
sub new
{
my($class, $client) = @_;
bless { client => $client }, $class;
}
sub AUTOLOAD
{
our $AUTOLOAD;
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/^.*://;
$name =~ s/_(.)/uc $1/eg;
my $class = join('::', qw( AnyEvent FTP Client Site ), ucfirst($name) );
eval qq{ use $class () };
die $@ if $@;
$class->new($self->{client});
}
# don't autoload DESTROY
sub DESTROY { }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Site - Dispatcher for site specific ftp commands
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site/ 000755 000000 000000 00000000000 15123245460 020645 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site/Base.pm 000644 000000 000000 00000001514 15123245460 022056 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Site::Base;
use strict;
use warnings;
use 5.010;
use Moo;
# ABSTRACT: base class for AnyEvent::FTP::Client::Site::* classes
our $VERSION = '0.20'; # VERSION
sub BUILDARGS
{
my($class, $client) = @_;
return { client => $client };
}
has client => ( is => 'ro', required => 1 );
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Site::Base - base class for AnyEvent::FTP::Client::Site::* classes
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site/Microsoft.pm 000644 000000 000000 00000003020 15123245460 023143 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Site::Microsoft;
use strict;
use warnings;
use 5.010;
use Moo;
extends 'AnyEvent::FTP::Client::Site::Base';
# ABSTRACT: Site specific commands for Microsoft FTP Service
our $VERSION = '0.20'; # VERSION
# TODO add a test for this
sub dirstyle { shift->client->push_command([SITE => 'DIRSTYLE'] ) }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Site::Microsoft - Site specific commands for Microsoft FTP Service
=head1 VERSION
version 0.20
=head1 SYNOPSIS
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new;
$client->connect('ftp://iisserver')->cb(sub {
# toggle dir style
$client->site->microsoft->dirstyle->cb(sub {
$client->list->cb(sub {
my $list = shift
# $list is in first style.
$client->site->microsoft->dirstyle->cb(sub {
$client->list->cb(sub {
my $list = shift;
# list is in second style.
});
});
});
});
});
=head1 DESCRIPTION
This class provides Microsoft's IIS SITE commands.
=head1 METHODS
=head2 dirstyle
$client->site->microsoft->dirstyle
Toggle between directory listing output styles.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site/NetFtpServer.pm 000644 000000 000000 00000003250 15123245460 023572 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Site::NetFtpServer;
use strict;
use warnings;
use 5.010;
use Moo;
extends 'AnyEvent::FTP::Client::Site::Base';
# ABSTRACT: Site specific commands for Net::FTPServer
our $VERSION = '0.20'; # VERSION
# TODO add a test for this
sub version { shift->client->push_command([SITE => 'VERSION'] ) }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Site::NetFtpServer - Site specific commands for Net::FTPServer
=head1 VERSION
version 0.20
=head1 SYNOPSIS
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new;
$client->connect('ftp://netftpserver')->cb(sub {
$client->site->net_ftp_server->version->cb(sub {
my($res) = @_;
# $res isa AnyEvent::FTP::Client::Response where
# the message includes the server version
});
});
=head1 DESCRIPTION
This class provides the C specific commands for L.
=head1 METHODS
=head2 version
$client->site->net_ftp_server->version
Get the L version.
=head1 CAVEATS
Other C commands supported by L, but not implemented by
this class include:
=over 4
=item SITE ALIAS
=item SITE ARCHIVE
=item SITE CDPATH
=item SITE CHECKMETHOD
=item SITE CHECKSUM
=item SITE EXEC
=item SITE IDLE
=item SITE SYNC
=back
patches that include tests are welcome.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Site/Proftpd.pm 000644 000000 000000 00000005017 15123245460 022624 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Site::Proftpd;
use strict;
use warnings;
use 5.010;
use Moo;
extends 'AnyEvent::FTP::Client::Site::Base';
# ABSTRACT: Site specific commands for Proftpd
our $VERSION = '0.20'; # VERSION
sub utime { shift->client->push_command([SITE => "UTIME $_[0] $_[1]"] ) }
sub mkdir { shift->client->push_command([SITE => "MKDIR $_[0]"] ) }
sub rmdir { shift->client->push_command([SITE => "RMDIR $_[0]"] ) }
sub symlink { shift->client->push_command([SITE => "SYMLINK $_[0] $_[1]"] ) }
sub ratio { shift->client->push_command([SITE => "RATIO"] ) }
sub quota { shift->client->push_command([SITE => "QUOTA"] ) }
sub help { shift->client->push_command([SITE => "HELP $_[0]"] ) }
sub chgrp { shift->client->push_command([SITE => "CHGRP $_[0] $_[1]"] ) }
sub chmod { shift->client->push_command([SITE => "CHMOD $_[0] $_[1]"] ) }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Site::Proftpd - Site specific commands for Proftpd
=head1 VERSION
version 0.20
=head1 SYNOPSIS
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new;
$client->connect('ftp://proftpdserver')->cb(sub {
$client->site->proftpd->symlink('foo', 'bar');
});
=head1 DESCRIPTION
This class implements site specific commands for the Proftpd server.
The implementation may be incomplete, and the documentation definitely is.
Patches are welcome to fix this.
=head1 METHODS
=head2 utime
$client->site->proftpd->utime( $arg1, $arg2 );
Execute C command.
=head2 mkdir
$client->site->proftpd->mkdir( $arg1 );
Execute C command.
=head2 rmdir
$client->site->proftpd->rmdir( $arg1 );
Execute C command.
=head2 symlink
$client->site->proftpd->symlink( $arg1, $arg2 );
Execute C command.
=head2 ratio
$client->site->proftpd->ratio;
Execute C command.
=head2 help
$client->site->proftpd->help( $arg1 );
Execute C command.
=head2 chgrp
$client->site->proftpd->chgrp( $arg1, $arg2 );
Execute C command.
=head2 chmodk
$client->site->proftpd->chmodk( $arg1, $arg2 );
Execute C command.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Transfer.pm 000644 000000 000000 00000010127 15123245460 022064 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Transfer;
use strict;
use warnings;
use 5.010;
use Moo;
use AnyEvent;
use AnyEvent::Handle;
use Carp qw( confess );
# ABSTRACT: Transfer class for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
# TODO: implement ABOR
with 'AnyEvent::FTP::Role::Event';
__PACKAGE__->define_events(qw( open close eof ));
has cv => (
is => 'ro',
lazy => 1,
default => sub { AnyEvent->condvar },
);
has client => (
is => 'ro',
required => 1,
);
has remote_name => (
is => 'rw',
lazy => 1,
default => sub { shift->command->[1] },
);
has local => (
is => 'ro',
required => 1,
);
has command => (
is => 'ro',
required => 1,
);
has restart => (
is => 'ro',
default => sub { 0 },
coerce => sub { $_[0] // 0 },
);
sub cb { shift->{cv}->cb(@_) }
sub ready { shift->{cv}->ready }
sub recv { shift->{cv}->recv }
sub handle
{
my($self, $fh) = @_;
my $handle;
$handle = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my($hdl, $fatal, $msg) = @_;
$self->emit('eof');
$_[0]->destroy;
},
on_eof => sub {
$self->emit('eof');
$handle->destroy;
},
# this avoids deep recursion exception error (usually
# a warning) in example fput.pl when the buffer is
# small (1024 on my debian VM)
autocork => 1,
);
$self->emit(open => $handle);
$handle;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Transfer - Transfer class for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 SYNOPSIS
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client;
$client->connect('ftp://ftp.cpan.org')->cb(sub {
# $upload_transfer and $download_transfer are instances of
# AnyEvent::FTP::Client::Transfer
my $upload_transfer = $client->stor('remote_filename.txt', 'content');
my $buffer;
my $download_transfer = $client->retr('remote_filename.txt', \$buffer);
});
=head1 DESCRIPTION
This class represents a file transfer with a remote server. Transfers
may be initiated between a remote file name and a local object. The
local object may be a regular scalar, reference to a scalar or a file
handle, for details, see the C, C, C and C
methods in L.
This documentation covers what you can do with the transfer object once it
has been initiated.
=head1 ROLES
This class consumes these roles:
=over 4
=item *
L
=back
=head1 EVENTS
This class provides these events:
=head2 open
Emitted when the data connection is opened, and passes in as its first argument
the L instance used to transfer the file.
$xfer->on_open(sub {
my($handle) = @_;
# $handle isa AnyEvent::Handle
});
=head2 close
Emitted when the transfer is complete, either due to a successful transfer or
the server returned a failure status. Passes in the final
L message associated with the transfer.
$xfer->on_close(sub {
my($res) = @_;
# $res isa AnyEvent::FTP::Client::Response
});
=head2 eof
Emitted when the data connection closes.
$xfer->on_eof(sub {
# no args passed in
});
=head1 METHODS
=head2 cb
Register a callback with the transfer to be executed when the transfer
successfully completes, or fails. Works exactly like the L condition
variable C method.
=head2 ready
Returns true if the transfer has completed (either successfully or not). If true, then it is safe to call
C to retrieve the response (Some event loops do not support calling C before there is a message
waiting).
=head2 recv
Retrieve the L object.
=head2 remote_name
For C transfers ONLY, this returns the remote file name.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Transfer/ 000755 000000 000000 00000000000 15123245460 021525 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Transfer/Active.pm 000644 000000 000000 00000004233 15123245460 023300 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Transfer::Active;
use strict;
use warnings;
use Moo;
use 5.010;
use AnyEvent;
use AnyEvent::Socket qw( tcp_server );
extends 'AnyEvent::FTP::Client::Transfer';
# ABSTRACT: Active transfer class for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
sub BUILD
{
my($self) = @_;
my $local = $self->convert_local($self->local);
my $count = 0;
my $guard;
$guard = tcp_server $self->client->{my_ip}, undef, sub {
my($fh, $host, $port) = @_;
# TODO double check the host/port combo here.
return close $fh if ++$count > 1;
undef $guard; # close to additional connections.
$self->xfer($fh,$local);
}, sub {
my($fh, $host, $port) = @_;
my $ip_and_port = join(',', split(/\./, $self->client->{my_ip}), $port >> 8, $port & 0xff);
my $w;
$w = AnyEvent->timer(after => 0, cb => sub {
$self->push_command(
[ PORT => $ip_and_port ],
($self->restart > 0 ? ([ REST => $self->restart ]) : ()),
$self->command,
);
undef $w;
});
};
$self->cv->cb(sub {
my $res = eval { shift->recv } // $@;
$self->emit('close' => $res);
});
}
package AnyEvent::FTP::Client::Transfer::Active::Fetch;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Active';
with 'AnyEvent::FTP::Client::Role::FetchTransfer';
package AnyEvent::FTP::Client::Transfer::Active::Store;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Active';
with 'AnyEvent::FTP::Client::Role::StoreTransfer';
package AnyEvent::FTP::Client::Transfer::Active::List;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Active';
with 'AnyEvent::FTP::Client::Role::ListTransfer';
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Transfer::Active - Active transfer class for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Client/Transfer/Passive.pm 000644 000000 000000 00000004064 15123245460 023501 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Client::Transfer::Passive;
use strict;
use warnings;
use Moo;
use 5.010;
use AnyEvent::Socket qw( tcp_connect );
extends 'AnyEvent::FTP::Client::Transfer';
# ABSTRACT: Passive transfer class for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
sub BUILD
{
my($self) = @_;
my $local = $self->convert_local($self->local);
my $data_connection = sub {
my $res = shift;
return if $res->is_preliminary;
my($ip, $port) = $res->get_address_and_port;
if(defined $ip && defined $port)
{
tcp_connect $ip, $port, sub {
my($fh) = @_;
unless($fh)
{
return "unable to connect to data port: $!";
}
$self->xfer($fh,$local);
};
return;
}
else
{
$res;
}
};
$self->push_command(
[ 'PASV', undef, $data_connection ],
($self->restart > 0 ? ([ REST => $self->restart ]) : ()),
$self->command,
);
$self->cv->cb(sub {
my $res = eval { shift->recv } // $@;
$self->emit('close' => $res);
});
}
package AnyEvent::FTP::Client::Transfer::Passive::Fetch;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Passive';
with 'AnyEvent::FTP::Client::Role::FetchTransfer';
package AnyEvent::FTP::Client::Transfer::Passive::Store;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Passive';
with 'AnyEvent::FTP::Client::Role::StoreTransfer';
package AnyEvent::FTP::Client::Transfer::Passive::List;
use Moo;
extends 'AnyEvent::FTP::Client::Transfer::Passive';
with 'AnyEvent::FTP::Client::Role::ListTransfer';
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Client::Transfer::Passive - Passive transfer class for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Request.pm 000644 000000 000000 00000003441 15123245460 020513 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Request;
use strict;
use warnings;
use 5.010;
use overload '""' => sub { shift->as_string }, bool => sub { 1 }, fallback => 1;
# ABSTRACT: Request class for asynchronous ftp server
our $VERSION = '0.20'; # VERSION
sub new
{
my($class, $cmd, $args, $raw) = @_;
bless { command => $cmd, args => $args, raw => $raw }, $class;
}
sub command { shift->{command} }
sub args { shift->{args} }
sub raw { shift->{raw} }
sub as_string
{
my $self = shift;
join ' ', $self->command, $self->args;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Request - Request class for asynchronous ftp server
=head1 VERSION
version 0.20
=head1 DESCRIPTION
Instances of this class represent client requests.
=head1 ATTRIBUTES
=head2 command
my $command = $req->command;
The command, usually something like C, C, C, etc.
=head2 args
my $args = $res->args;
The arguments passed in with the command
=head2 raw
my $raw = $res->raw;
The raw, unparsed request.
=head1 METHODS
=head2 as_string
my $str = $res->as_string
my $str = "$res";
Returns a string representation of the request. This may not be exactly the same as
what was actually sent to the server (see C attribute for that). You can also
call this by treating the object like a string (using string operators, or including
it in a double quoted string), so
print "$req";
is the same as
print $req->as_string;
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Response.pm 000644 000000 000000 00000005357 15123245460 020671 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Response;
use strict;
use warnings;
use 5.010;
use overload
'""' => sub { shift->as_string },
fallback => 1,
bool => sub { 1 }, fallback => 1;
# ABSTRACT: Response class for asynchronous ftp client
our $VERSION = '0.20'; # VERSION
sub new
{
my($class, $code, $message) = @_;
$message = [ $message ] unless ref($message) eq 'ARRAY';
bless { code => $code, message => $message }, $class;
}
sub code { shift->{code} }
sub message { shift->{message} }
sub is_success { shift->{code} !~ /^[45]/ }
sub is_preliminary { shift->{code} =~ /^1/ }
sub as_string
{
my($self) = @_;
sprintf "[%d] %s%s", $self->{code}, $self->{message}->[0], @{ $self->{message} } > 1 ? '...' : '';
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Response - Response class for asynchronous ftp client
=head1 VERSION
version 0.20
=head1 DESCRIPTION
Instances of this class represent a FTP server response.
=head1 ATTRIBUTES
=head2 code
my $code = $client->code;
Integer code for the message. These can be categorized thus:
=over 4
=item 1xx
Positive preliminary reply
=item 2xx
Positive completion reply
=item 3xx
Positive intermediate reply
=item 4xx
Transient negative reply
=item 5xx
Permanent negative reply
=back
Generally C<4xx> and C<5xx> messages are errors, where as C<1xx>, C<3xx> are various states of
(at least so far) successful operations. C<2xx> indicates a completely successful
operation.
=head2 message
my $message = $res->message;
The human readable message returned from the server. This is always a list reference,
even if the server only returned one line.
=head1 METHODS
=head2 is_success
my $bool = $res->is_success;
True if the response does not represent an error condition (codes C<1xx>, C<2xx> or C<3xx>).
=head2 is_preliminary
my $bool = $res->is_preliminary;
True if the response is a preliminary positive reply (code C<1xx>).
=head2 as_string
my $str = $res->as_string;
my $str = "$res";
Returns a string representation of the response. This may not be exactly what was
returned by the server, but will include the code and at least part of the message in
a human readable format.
You can also get this string by treating objects of this class as a string (using
it in a double quoted string, or by using string operators):
print "$res";
is the same as
print $res->as_string;
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Role/ 000755 000000 000000 00000000000 15123245460 017424 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Role/Event.pm 000644 000000 000000 00000004757 15123245460 021060 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Role::Event;
use strict;
use warnings;
use 5.010;
use Moo::Role;
# ABSTRACT: Event interface for AnyEvent::FTP objects
our $VERSION = '0.20'; # VERSION
sub define_events
{
my $class = shift;
foreach my $name (@_)
{
my $method_name = join '::', $class, "on_$name";
my $method = sub {
my($self, $cb) = @_;
push @{ $self->{event}->{$name} }, $cb;
$self;
};
no strict 'refs';
*$method_name = $method;
}
}
sub emit
{
my($self, $name, @args) = @_;
for(@{ $self->{event}->{$name} })
{
eval { $_->(@args) };
warn $@ if $@;
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Role::Event - Event interface for AnyEvent::FTP objects
=head1 VERSION
version 0.20
=head1 SYNOPSIS
package AnyEvent::FTP::Foo;
use Moo;
with 'AnyEvent::FTP::Role::Event';
__PACKAGE__->define_events(qw( error good ));
sub some_method
{
my($self) = @_;
if($self->other_method)
{
$self->emit(good => 'paylod message');
}
else
{
$self->emit(error => 'something went wrong!');
}
}
later on somewhere else
use AnyEvent::FTP::Foo;
my $foo = AnyEvent::FTP::Foo->new;
$foo->on_good(sub {
my($message) = @_;
print "worked: $message";
});
$foo->on_error(sub {
my($message) = @_;
print "failed: $message";
});
$foo->some_method
=head1 DESCRIPTION
This role provides a uniform even callback mechanism for classes in L.
You declare events by using the C method. Once declared
you can use CI to add a callback to a particular event
and C to trigger those callbacks.
=head1 METHODS
=head2 define_events
__PACKAGE__->define_events( @list_of_event_names );
This is called within the class package to declare the event names for all
events used by the class. It creates methods of the form CI
which can be used to add callbacks to events.
=head2 emit
$obj->emit($event_name, @arguments);
This calls the callbacks associated with the given C<$event_name>.
It will pass to that callback the given C<@arguments>.
=head1 SEE ALSO
=over 4
=item *
L
=back
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server.pm 000644 000000 000000 00000014013 15123245460 020326 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Server;
use strict;
use warnings;
use 5.010;
use Moo;
use AnyEvent::Handle;
use AnyEvent::Socket qw( tcp_server );
use AnyEvent::FTP::Server::Connection;
use Socket qw( unpack_sockaddr_in inet_ntoa );
# ABSTRACT: Simple asynchronous ftp server
our $VERSION = '0.20'; # VERSION
$AnyEvent::FTP::Server::VERSION //= 'dev';
with 'AnyEvent::FTP::Role::Event';
__PACKAGE__->define_events(qw( bind connect ));
has hostname => (
is => 'ro',
);
has port => (
is => 'ro',
default => sub { 21 },
);
has default_context => (
is => 'ro',
default => sub { 'AnyEvent::FTP::Server::Context::FSRW' },
);
has welcome => (
is => 'ro',
default => sub { [ 220 => "aeftpd $AnyEvent::FTP::Server::VERSION" ] },
);
has bindport => (
is => 'rw',
);
has inet => (
is => 'ro',
default => sub { 0 },
);
sub BUILD
{
eval 'use ' . shift->default_context;
die $@ if $@;
}
sub start
{
my($self) = @_;
$self->inet ? $self->_start_inet : $self->_start_standalone;
}
sub _start_inet
{
my($self) = @_;
my $con = AnyEvent::FTP::Server::Connection->new(
context => $self->{default_context}->new,
ip => do {
my $sockname = getsockname STDIN;
my ($sockport, $sockaddr) = unpack_sockaddr_in ($sockname);
inet_ntoa ($sockaddr);
},
);
my $handle;
$handle = AnyEvent::Handle->new(
fh => *STDIN,
on_error => sub {
my($hdl, $fatal, $msg) = @_;
$con->close;
$_[0]->destroy;
undef $handle;
undef $con;
},
on_eof => sub {
$con->close;
$handle->destroy;
undef $handle;
undef $con;
},
);
$self->emit(connect => $con);
STDOUT->autoflush(1);
STDIN->autoflush(1);
$con->on_response(sub {
my($raw) = @_;
print STDOUT $raw;
});
$con->on_close(sub {
close STDOUT;
exit;
});
$con->send_response(@{ $self->welcome });
$handle->on_read(sub {
$handle->push_read( line => sub {
my($handle, $line) = @_;
$con->process_request($line);
});
});
$self;
}
sub _start_standalone
{
my($self) = @_;
my $prepare = sub {
my($fh, $host, $port) = @_;
$self->bindport($port);
$self->emit(bind => $port);
};
my $connect = sub {
my($fh, $host, $port) = @_;
my $con = AnyEvent::FTP::Server::Connection->new(
context => $self->{default_context}->new,
ip => do {
my($port, $addr) = unpack_sockaddr_in getsockname $fh;
inet_ntoa $addr;
},
);
my $handle;
$handle = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my($hdl, $fatal, $msg) = @_;
$con->close;
$_[0]->destroy;
undef $handle;
undef $con;
},
on_eof => sub {
$con->close;
$handle->destroy;
undef $handle;
undef $con;
},
);
$self->emit(connect => $con);
$con->on_response(sub {
my($raw) = @_;
$handle->push_write($raw);
});
$con->on_close(sub {
$handle->push_shutdown;
});
$con->send_response(@{ $self->welcome });
$handle->on_read(sub {
$handle->push_read( line => sub {
my($handle, $line) = @_;
$con->process_request($line);
});
});
};
tcp_server $self->hostname, $self->port || undef, $connect, $prepare;
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Server - Simple asynchronous ftp server
=head1 VERSION
version 0.20
=head1 SYNOPSIS
use AnyEvent;
use AnyEvent::FTP::Server;
my $server = AnyEvent::FTP::Server->new;
$server->start;
AnyEvent->condvar->recv;
=head1 DESCRIPTION
B L hasn't been audited by anyone, including
its author, in order to ensure that it is secure. It is intended to be used
primarily in testing the companion client L. It can
also be used to write your own context or personality (to use the L
terminology) that use alternate back ends (say a database or memory store)
that could theoretically be made to be secure, but you will need to carefully
vett both the L code as well as your own customizations
before you deploy on the Internet or on an untrusted network.
This class is used for L server instances.
Each time a client connects to the server a L
instance is created to manage the TCP connection. Each connection
also has a L which defines the behavior or
personality of the server, and each context instance keeps track of the
current directory, user authentication and authorization status of each
connected client.
=head1 ATTRIBUTES
=head2 hostname
my $hostname = $server->hostname;
Readonly, and should be assigned at the constructor. The hostname to listen
on.
=head2 port
my $port = $server->port;
The port to listen to. Default is 21 - a different port can be assigned
at the constructor.
=head2 default_context
my $context = $server->default_context;
Readonly: the default context class (can be set as a parameter in the
constructor).
=head2 welcome
my($code, $message) = @{ $server->welcome };
The welcome messages as key value pairs. Read only and can be overridden by
the constructor.
=head2 bindport
my $port = $server->bindport;
$server->bindport($port);
Retrieves or sets the TCP port to bind to.
=head2 inet
my $bool = $server->inet;
Readonly (assignable via the constructor). If true, then assume a TCP
connection has been established by inet. The default (false) is to start
a standalone server.
=head1 METHODS
=head2 start
$server->start;
Call this method to start the service.
=head1 SEE ALSO
L
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server/ 000755 000000 000000 00000000000 15123245460 017771 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server/Connection.pm 000644 000000 000000 00000004277 15123245460 022440 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Server::Connection;
use strict;
use warnings;
use 5.010;
use Moo;
use AnyEvent::FTP::Request;
# ABSTRACT: FTP Server connection class
our $VERSION = '0.20'; # VERSION
with 'AnyEvent::FTP::Role::Event';
__PACKAGE__->define_events(qw( request response close ));
has context => (
is => 'ro',
required => 1,
);
has response_encoder => (
is => 'ro',
lazy => 1,
default => sub {
require AnyEvent::FTP::Server::UnambiguousResponseEncoder;
AnyEvent::FTP::Server::UnambiguousResponseEncoder->new;
},
);
has ip => (
is => 'ro',
required => 1,
);
sub process_request
{
my($self, $line) = @_;
my $raw = $line;
$self->emit(request => $raw);
$line =~ s/\015?\012//g;
if($line =~ s/^([A-Z]{1,4})\s?//i)
{
$self->context->push_request($self, AnyEvent::FTP::Request->new(uc $1, $line, $raw));
}
else
{
$self->context->invalid_syntax($self, $raw);
}
$self;
}
sub send_response
{
my $self = shift;
my $raw = $self->response_encoder->encode(@_);
$self->emit(response => $raw);
$self;
}
sub close
{
my($self) = shift;
$self->emit('close');
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Server::Connection - FTP Server connection class
=head1 VERSION
version 0.20
=head1 METHODS
=head2 close
$conn->close;
Emits a close signal.
=head2 context
my $context_obj = $conn->context;
Required to be specified by the constructor and readonly - this is the
context object.
=head2 ip
my $ip = $conn->ip;
Required to be specified by the constructor and readonly - this is the
IP address.
=head2 process_request
$conn->process_request($line);
Process a single request. Returns the connection object ($conn).
=head2 send_response
$conn->send_response($res)
$conn->send_response($code, $message)
Sends the response. Returns the connection object ($conn).
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server/Context.pm 000644 000000 000000 00000006242 15123245460 021757 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Server::Context;
use strict;
use warnings;
use 5.010;
use Moo;
# ABSTRACT: FTP Server client context class
our $VERSION = '0.20'; # VERSION
with 'AnyEvent::FTP::Role::Event';
with 'AnyEvent::FTP::Server::Role::Context';
__PACKAGE__->define_events(qw( auth ));
has ready => (
is => 'rw',
default => sub { 1 },
);
has ascii_layer => (
is => 'rw',
default => ':raw:eol(CRLF-Native)'
);
sub push_request
{
my($self, $con, $req) = @_;
push @{ $self->{request_queue} }, [ $con, $req ];
$self->process_queue if $self->ready;
$self;
}
sub process_queue
{
my($self) = @_;
return $self unless @{ $self->{request_queue} } > 0;
$self->ready(0);
my($con, $req) = @{ shift @{ $self->{request_queue} } };
my $command = lc $req->command;
if($self->can('auth_command_check_hook'))
{
return unless $self->auth_command_check_hook($con, $command);
}
my $method = join '_', 'cmd', $command;
if($self->can($method))
{
$self->$method($con, $req);
}
else
{
$self->invalid_command($con, $req);
}
$self;
}
sub invalid_command
{
my($self, $con, $req) = @_;
$con->send_response(500 => $req->command . ' not understood');
$self->done;
}
sub invalid_syntax
{
my($self, $con, $raw) = @_;
$con->send_response(500 => 'Command not understood');
$self->done;
}
sub help_quit { "QUIT" }
sub cmd_quit
{
my($self, $con, $req) = @_;
$con->send_response(221 => 'Goodbye');
$con->close;
$self;
}
sub done
{
my($self) = @_;
$self->ready(1);
$self->process_queue;
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
AnyEvent::FTP::Server::Context - FTP Server client context class
=head1 VERSION
version 0.20
=head1 METHODS
=head2 cmd_quit
$ctx->cmd_quit($con, $req);
Sends a quit command through $con ($req is unused.). Returns the $ctx object.
=head2 done
$ctx->done;
B: document. Returns the $ctx object.
=head2 help_quit
my $quit_str = $ctx->help_quit;
Returns the string "QUIT".
=head2 invalid_command
$ctx->invalid_command($con, $req);
Sends an invalid command due to the request $req through $con.
=head2 invalid_syntax
$ctx->invalid_syntax($con, $raw);
Sends a command not understood response through $con.
=head2 process_queue
$ctx->process_queue;
Processes the request queue.
=head2 push_request
$ctx->push_request($con, $req);
Pushes the request to the queue.
=head2 ready
my $bool = $ctx->ready;
$ctx->ready($bool)
Gets or sets the "is ready" status, which is a boolean.
=head2 ascii_layer
$ctx->ascii_layer;
The L layer to apply for writing (C, C, C) and
reading (C) when operating under ASCII file transfer mode. By
default a layer that takes C and emits native line endings is used
for writing and a takes native line endings and emits C when reading
is used.
=head1 AUTHOR
Author: Graham Ollis Eplicease@cpan.orgE
Contributors:
Ryo Okamoto
Shlomi Fish
José Joaquín Atria
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server/Context/ 000755 000000 000000 00000000000 15123245460 021415 5 ustar 00root root 000000 000000 AnyEvent-FTP-0.20/lib/AnyEvent/FTP/Server/Context/FS.pm 000644 000000 000000 00000014771 15123245460 022275 0 ustar 00root root 000000 000000 package AnyEvent::FTP::Server::Context::FS;
use strict;
use warnings;
use 5.010;
use Moo;
use File::chdir;
use File::Spec;
extends 'AnyEvent::FTP::Server::Context';
# ABSTRACT: FTP server context that uses real file system (no transfers)
our $VERSION = '0.20'; # VERSION
with 'AnyEvent::FTP::Server::Role::Auth';
with 'AnyEvent::FTP::Server::Role::Help';
with 'AnyEvent::FTP::Server::Role::Old';
with 'AnyEvent::FTP::Server::Role::Type';
sub cwd
{
my($self, $value) = @_;
$self->{cwd} = $value if defined $value;
$self->{cwd} //= '/';
}
sub rename_from
{
my($self, $value) = @_;
$self->{rename_from} = $value if defined $value;
$self->{rename_from};
}
sub help_cwd { 'CWD pathname' }
sub cmd_cwd
{
my($self, $con, $req) = @_;
my $dir = $req->args;
eval {
die unless $dir;
use autodie;
local $CWD = $self->cwd;
$CWD = $dir;
$self->cwd($CWD);
$con->send_response(250 => 'CWD command successful');
};
$con->send_response(550 => 'CWD error') if $@;
$self->done;
}
sub help_cdup { 'CDUP' }
sub cmd_cdup
{
my($self, $con, $req) = @_;
eval {
use autodie;
local $CWD = $self->cwd;
$CWD = File::Spec->updir;
$self->cwd($CWD);
$con->send_response(250 => 'CDUP command successful');
};
$con->send_response(550 => 'CDUP error') if $@;
$self->done;
}
sub help_pwd { 'PWD' }
sub cmd_pwd
{
my($self, $con, $req) = @_;
my $cwd = $self->cwd;
if($^O eq 'MSWin32')
{
(undef,$cwd) = File::Spec->splitpath($cwd, 1);
$cwd =~ s{\\}{/}g;
}
$con->send_response(257 => "\"$cwd\" is the current directory");
$self->done;
}
sub help_size { 'SIZE pathname' }
sub cmd_size
{
my($self, $con, $req) = @_;
eval {
use autodie;
local $CWD = $self->cwd;
if(-f $req->args)
{
my $size = -s $req->args;
$con->send_response(213 => $size);
}
elsif(-e $req->args)
{
$con->send_response(550 => $req->args . ": not a regular file");
}
else
{
die;
}
};
if($@)
{
$con->send_response(550 => $req->args . ": No such file or directory");
}
$self->done;
}
sub help_mkd { 'MKD pathname' }
sub cmd_mkd
{
my($self, $con, $req) = @_;
my $dir = $req->args;
eval {
use autodie;
local $CWD = $self->cwd;
mkdir $dir;
$con->send_response(257 => "Directory created");
};
$con->send_response(550 => "MKD error") if $@;
$self->done;
}
sub help_rmd { 'RMD