pax_global_header00006660000000000000000000000064147047732420014524gustar00rootroot0000000000000052 comment=bf7ddb98114aa37497cc71ca23fee41786c3f6f3 ossp-eperl-ePerl_2_2_15/000077500000000000000000000000001470477324200151755ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/.builds/000077500000000000000000000000001470477324200165355ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/.builds/freebsd-latest.yml000066400000000000000000000003471470477324200221700ustar00rootroot00000000000000# SPDX-License-Identifier: 0BSD image: freebsd/latest packages: - gmake - autoconf - automake tasks: - build: | cd ossp-eperl autoreconf -fi ./configure make make check sudo make install ossp-eperl-ePerl_2_2_15/.builds/openbsd-latest.yml000066400000000000000000000004161470477324200222050ustar00rootroot00000000000000# SPDX-License-Identifier: 0BSD image: openbsd/latest packages: - gmake - autoconf-2.71 - automake-1.16.5 tasks: - build: | cd ossp-eperl AUTOMAKE_VERSION=1.16 autoreconf-2.71 -fi ./configure make make check doas make install ossp-eperl-ePerl_2_2_15/.builds/sid.yml000066400000000000000000000042511470477324200200410ustar00rootroot00000000000000# SPDX-License-Identifier: 0BSD image: debian/sid secrets: - 7733e7bd-bdd8-4fdb-a963-25132ff5442c # ossp-eperl SSH key packages: - clang - lld - libperl-dev - autoconf - automake - groff - ghostscript tasks: - build-gcc: | cd ossp-eperl autoreconf -fi ./configure make make check make distclean - build-clang: | cd ossp-eperl autoreconf -fi ./configure CC=clang CXX=clang++ LDFLAGS=-fuse-ld=lld --prefix=/usr make make check - install: | sudo make -C ossp-eperl install - manual: | sudo sh -c 'curl https://git.sr.ht/~nabijaczleweli/groff-1.23-unfucking/blob/trunk/mdoc.local >> /etc/groff/mdoc.local' git -C ossp-eperl/ worktree add ../ossp-eperl-man man cd ossp-eperl-man git ls-tree -z --name-only HEAD | xargs -0 rm -r cp ../ossp-eperl/eperl.1 ../ossp-eperl/mod/blib/man3/* . sed -e 's/…/.../g' $(printf '%s\n' *.[0-8]* | awk -F. '{print $2 "\t" $0}' | sort | cut -f2) | groff -K utf8 -tpe -man -Tps -dpaper=a4 -P-pa4 > ossp-eperl.ps ps2pdf ossp-eperl.ps ossp-eperl.pdf git add . git config user.email "nabijaczleweli/autouploader@nabijaczleweli.xyz" git config user.name "наб autouploader" git commit -m "Manpage update by job $JOB_ID" || exit 0 git remote set-url origin 'git@git.sr.ht:~nabijaczleweli/ossp-eperl' ssh-keyscan git.sr.ht > ~/.ssh/known_hosts git push - void: | curl https://repo-default.voidlinux.org/live/current/sha256sum.txt | grep -w tar | grep -w x86_64 | grep -m1 musl > sha256sum.txt curl -SL https://repo-default.voidlinux.org/live/current/"$(awk -F'[( )]' '{print $3}' < sha256sum.txt)" | tar -xJ cp /etc/resolv.conf etc printf '%s\n' 'xbps-install -yS' \ 'xbps-install -yu xbps' \ 'xbps-install -y make gcc perl' \ 'cd ossp-eperl' \ './configure' \ 'make clean all' \ 'make check || echo "Ignoring segfault in test (https://101010.pl/@nabijaczleweli/113167031459446409)"' \ 'make install' | sudo chroot . sh -ex ossp-eperl-ePerl_2_2_15/.gitignore000066400000000000000000000003461470477324200171700ustar00rootroot00000000000000*.cache config.* configure *~ *.o *.so mod/blib **/pm_to_blib **/MYMETA.* mod/Parse/ePerl.c mod/Parse/ePerl.bs mod/*/ePerl.pm Makefile libeperl.a eperl eperl.1 eperl.pod eperl_readme.c eperl_license.c eperl_logo.c eperl_powered.c ossp-eperl-ePerl_2_2_15/LICENSES/000077500000000000000000000000001470477324200164025ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/LICENSES/0BSD.txt000066400000000000000000000011371470477324200176350ustar00rootroot00000000000000Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ossp-eperl-ePerl_2_2_15/LICENSES/Artistic-1.0-Perl.txt000066400000000000000000000137371470477324200221340ustar00rootroot00000000000000 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 MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End ossp-eperl-ePerl_2_2_15/LICENSES/GPL-2.0-only.txt000066400000000000000000000431271470477324200210500ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU 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. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of 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 show them these terms so they know 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. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. 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 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 derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 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 License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary 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 License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 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 Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing 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 for copying, distributing or modifying the Program or works based on it. 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. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. 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 this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. 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 11. 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. 12. 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 How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively 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 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. 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) 19yy 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 is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. ossp-eperl-ePerl_2_2_15/Makefile.in000066400000000000000000000104451470477324200172460ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1996-2000 Ralf S. Engelschall, All Rights Reserved. @SET_MAKE@ # imported Perl 5 parameters perl_prog = @perl_prog@ perl_cc = @perl_cc@ perl_optimize = @perl_optimize@ perl_ccflags = @perl_ccflags@ perl_ldflags = @perl_ldflags@ perl_libs = @perl_libs@ perl_dla = @perl_dla@ perl_ccdlflags = @perl_ccdlflags@ perl_cccdlflags = @perl_cccdlflags@ perl_archlib = @perl_archlib@ # compiler tools CC = $(perl_cc) CFLAGS = @CFLAGS@ $(perl_optimize) $(perl_ccflags) -I$(perl_archlib)/CORE -I. CPPFLAGS = @CPPFLAGS@ DLCFLAGS = @CFLAGS@ $(perl_optimize) $(perl_cccdlflags) $(perl_ccflags) -I$(perl_archlib)/CORE -I. LDFLAGS = @LDFLAGS@ $(perl_ccdlflags) $(perl_ldflags) -L$(perl_archlib)/CORE LDLIBS = @LIBS@ $(perl_dla) -lperl $(perl_libs) AR = @AR@ # installation paths prefix = @prefix@ exec_prefix = $(prefix) bindir = $(prefix)/bin libsubdir = @libsubdir@ libdir = $(prefix)/lib$(libsubdir) mandir = $(prefix)/share/man/man1 all: eperl eperl.1 mod SRCS = \ eperl_main.c \ eperl_perl5.c \ eperl_parse.c \ eperl_pp.o \ eperl_sys.c \ eperl_http.c \ eperl_readme.c \ eperl_license.c \ eperl_logo.c \ eperl_powered.c OBJS = \ eperl_main.o \ eperl_perl5.o \ eperl_parse.o \ eperl_pp.o \ eperl_sys.o \ eperl_http.o \ eperl_readme.o \ eperl_license.o \ eperl_logo.o \ eperl_powered.o eperl: $(OBJS) $(CC) $(LDFLAGS) -o eperl $(OBJS) $(LDLIBS) eperl_main.o: eperl_main.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_main.c eperl_perl5.o: eperl_perl5.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_perl5.c eperl_parse.o: eperl_parse.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_parse.c eperl_pp.o: eperl_pp.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_pp.c eperl_sys.o: eperl_sys.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_sys.c eperl_debug.o: eperl_debug.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_debug.c eperl_http.o: eperl_http.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_http.c eperl_readme.c: README $(perl_prog) bin2c ePerl_README < README > eperl_readme.c eperl_license.c: LICENSES/* head -n99999 LICENSES/* | $(perl_prog) bin2c ePerl_LICENSE > eperl_license.c eperl_logo.c: eperl_logo.gif $(perl_prog) bin2c ePerl_LOGO < eperl_logo.gif > eperl_logo.c eperl_powered.c: eperl_powered.png $(perl_prog) bin2c ePerl_POWERED < eperl_powered.png > eperl_powered.c eperl_readme.o: eperl_readme.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_readme.c eperl_license.o: eperl_license.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_license.c eperl_logo.o: eperl_logo.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_logo.c eperl_powered.o: eperl_powered.c $(CC) $(CFLAGS) $(CPPFLAGS) -c eperl_powered.c eperl.1: eperl.pod pod2man -u --section=1 --center="Ralf S. Engelschall" --release="ossp-eperl @EPERL_VERSION_SHORT@" --date="@EPERL_VERSION_DATE@" eperl.pod >eperl.1 .PHONY: mod mod: mod/blib/arch/auto/Parse/ePerl/ePerl.so mod/blib/arch/auto/Parse/ePerl/ePerl.so: libeperl.a mod/*/ePerl.pm mod/*/ePerl.xs rm -f mod/blib/arch/auto/Parse/ePerl/ePerl.so $(MAKE) -C mod SOBJS = \ eperl_parse.so \ eperl_pp.so \ eperl_sys.so \ eperl_http.so libeperl.a: $(SOBJS) $(AR) -cr libeperl.a $(SOBJS) eperl_parse.so: eperl_parse.c $(CC) $(DLCFLAGS) $(CPPFLAGS) -o eperl_parse.so -c eperl_parse.c eperl_pp.so: eperl_pp.c $(CC) $(DLCFLAGS) $(CPPFLAGS) -o eperl_pp.so -c eperl_pp.c eperl_sys.so: eperl_sys.c $(CC) $(DLCFLAGS) $(CPPFLAGS) -o eperl_sys.so -c eperl_sys.c eperl_http.so: eperl_http.c $(CC) $(DLCFLAGS) $(CPPFLAGS) -o eperl_http.so -c eperl_http.c check: all cd t && @perl_prog@ -e 'use Test::Harness; $$Test::Harness::verbose = "$(V)"; Test::Harness::runtests(glob("*.t"));' $(MAKE) -C mod test install: all mkdir -p $(DESTDIR)$(bindir) $(DESTDIR)$(mandir) $(DESTDIR)$(libdir) cp eperl $(DESTDIR)$(bindir)/ cp eperl.1 $(DESTDIR)$(mandir)/ cp eg/demo.* $(DESTDIR)$(libdir)/ $(MAKE) -C mod install clean: -rm -f $(OBJS) -rm -f eperl eperl.1 -rm -f $(SOBJS) -rm -f libeperl.a -rm -f core *.core -rm -f eperl_readme.c eperl_license.c eperl_logo.c eperl_powered.c -$(MAKE) -C mod clean -find mod/ -name Makefile.old -exec sh -xc 'mv $$0 $${0%.old}' {} \; distclean: clean -rm -f config.* configure -rm -f Makefile eperl.pod mod/*/ePerl.pm -$(MAKE) -C mod distclean ossp-eperl-ePerl_2_2_15/README000066400000000000000000000046311470477324200160610ustar00rootroot00000000000000 ____ _ ___| _ \ ___ _ __| | / _ \ |_) / _ \ '__| | | __/ __/ __/ | | | \___|_| \___|_| |_| ePerl -- Embedded Perl 5 Language Version 2.2.15 (2024-10-19) ePerl interprets a text file sprinkled with Perl 5 program statements by evaluating the Perl 5 code while copying the plain text data verbatim. It can operate in various ways: As a stand-alone Unix filter or integrated Perl 5 module for general file generation tasks and as a powerful Webserver scripting language for dynamic HTML page programming. This is a thawed OSSP project; for git repository/bug tracker/mailing list see https://sr.ht/~nabijaczleweli/ossp The manual is available on-line and at https://srhtcdn.githack.com/~nabijaczleweli/ossp-eperl/blob/man/ossp-eperl.pdf Release tarballs are signed with nabijaczleweli@nabijaczleweli.xyz (pull with WKD, but 7D69 474E 8402 8C5C C0C4 4163 BCFD 0B01 8D26 58F1). аnd stored in git notes as-if via the example program provided at https://man.sr.ht/git.sr.ht/#signing-tags-tarballs and are thus available on the refs listing/tag page as .tar.gz{,.asc}: https://git.sr.ht/~nabijaczleweli/ossp-uuid/refs Wants a recent C compiler, Perl, and autoconf/automake: $ autoreconf -fi $ ./configure [--with-perl=$(command -v perl perl5 miniperl)] \ [--with-allowed-caller=nobody, root] \ [autoconf variables]... $ make ... The documentation and latest release can be found on http://www.engelschall.com/sw/eperl/ Copyright (c) 1996-2000 Ralf S. Engelschall This program is free software; it may be redistributed and/or modified only under the terms of either the Artistic License or the GNU General Public License version 2, which may be found in the ePerl source distribution. Look at the files LICENSES/Artistic-1.0-Perl.txt and LICENSES/GPL-2.0-only.txt or run "eperl -l" to receive a built-in copy of both license files. 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 either the Artistic License or the GNU General Public License for more details. Ralf S. Engelschall rse@engelschall.com www.engelschall.com ossp-eperl-ePerl_2_2_15/bin2c000077500000000000000000000003731470477324200161230ustar00rootroot00000000000000#!/usr/bin/perl # SPDX-License-Identifier: 0BSD print "#include \"eperl.h\"\n"; print "const uint8_t ${ARGV[0]}[] = {\n\t"; while(read(STDIN, $_, 1) == 1) { print ord.","; } print "\n};\n"; print "const size_t ${ARGV[0]}_size = ".(tell STDIN).";\n"; ossp-eperl-ePerl_2_2_15/configure.ac000066400000000000000000000130131470477324200174610ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only dnl ## Copyright (c) 1996-1999 Ralf S. Engelschall, AC_PREREQ([2.71]) AC_INIT EPERL_VERSION_SHORT='2.2.15' EPERL_VERSION_DATE='2024-10-19' echo "Configuring for ePerl, Version $EPERL_VERSION_SHORT ($EPERL_VERSION_DATE)" AC_SUBST(EPERL_VERSION_SHORT) AC_SUBST(EPERL_VERSION_DATE) AC_DEFINE_UNQUOTED(EPERL_VERSION_SHORT, "$EPERL_VERSION_SHORT", [ePerl version]) AC_DEFINE_UNQUOTED(EPERL_VERSION_DATE, "$EPERL_VERSION_DATE", [ePerl version date]) AC_CONFIG_HEADERS([config.h]) dnl # dnl # libdir adjustment dnl # test "x$prefix" = xNONE && prefix=$ac_default_prefix eval "dir=$prefix" case $dir in *eperl* ) libsubdir= ;; * ) libsubdir="/eperl" ;; esac AC_SUBST(libsubdir) dnl # dnl # latest find Perl interpreter dnl # AC_MSG_RESULT(CHECK: Configuration of Perl Language) AC_MSG_CHECKING([for Perl language]) AC_ARG_WITH(perl,dnl [ --with-perl=PATH force the usage of a specific Perl 5 interpreter], perl_prog=$with_perl , perl_prog=$(command -v perl || command -v perl5 || command -v miniperl) )dnl dnl [[ perl_vers="$($perl_prog -e 'printf("%.3f", $]);')" dnl ] AC_MSG_RESULT([$perl_prog v$perl_vers]) if ! test -f "$perl_prog"; then AC_MSG_ERROR(required program perl not found) fi AC_MSG_CHECKING([which UIDs/usernames to allow when running set-UID]) AC_ARG_WITH(allowed-caller-uids,dnl [ --with-allowed-caller-uids=username,uid,... when running set-UID, refuse to switch user IDs (or exit) if it's not in this list (default: "nobody, root")], [], [with_allowed_caller_uids='nobody, root'] )dnl AC_MSG_RESULT([$with_allowed_caller_uids]) ALLOWED_CALLER_UID="$(IFS="$IFS,"; printf '"%s", ' $with_allowed_caller_uids)" AC_DEFINE_UNQUOTED(ALLOWED_CALLER_UID, $ALLOWED_CALLER_UID, [initialiser for allowed_caller_uid]) AC_SUBST(with_allowed_caller_uids) dnl # dnl # determine Perl parameters dnl # AC_MSG_CHECKING([for Perl knowledge of system]) perl_os="$($perl_prog -e 'use Config; print "$Config{osname}-$Config{osvers}"')" AC_MSG_RESULT([$perl_os]) AC_MSG_CHECKING([for Perl standard compiler]) perl_cc="$($perl_prog -e 'use Config; print $Config{cc}')" if test -z "$CC"; then CC=$perl_cc export CC AC_MSG_RESULT([$perl_cc]) else perl_cc=$CC AC_MSG_RESULT([$perl_cc (OVERWRITTEN)]) fi AC_SUBST(perl_cc) AC_MSG_CHECKING([for Perl standard optimization flags]) perl_optimize="$($perl_prog -e 'use Config; print $Config{optimize}')" AC_MSG_RESULT([$perl_optimize]) AC_SUBST(perl_optimize) AC_MSG_CHECKING([for Perl standard compilation flags]) perl_ccflags="$($perl_prog -e 'use Config; print $Config{ccflags}')" case $perl_os in *hpux* ) perl_ccflags="$perl_ccflags -Wp,-H32768" ;; esac AC_MSG_RESULT([$perl_ccflags]) AC_SUBST(perl_ccflags) AC_MSG_CHECKING([for Perl standard link flags]) perl_ldflags="$($perl_prog -e 'use Config; print $Config{ldflags}')" AC_MSG_RESULT([$perl_ldflags]) AC_SUBST(perl_ldflags) AC_MSG_CHECKING([for Perl library files]) perl_libs="$($perl_prog -e 'use Config; print $Config{libs} =~ s/-l\S*db\S*//gr =~ s/^\s*//r')" AC_MSG_RESULT([$perl_libs]) AC_SUBST(perl_libs) AC_MSG_CHECKING([for Perl architecture directory]) perl_archlib="$($perl_prog -e 'use Config; print $Config{archlib}')" AC_MSG_RESULT([$perl_archlib]) AC_SUBST(perl_archlib) AC_MSG_CHECKING([for Perl dynamic loading support]) usedl="$($perl_prog -e 'use Config; print $Config{usedl}')" case $usedl in define ) AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_PERL_DYNALOADER, 1, defined if Perl support the DynLoader interface for dynamic library loading) perl_dla="$($perl_prog -MExtUtils::Embed -e ldopts)" ;; * ) AC_MSG_RESULT([no]) perl_dla= ;; esac AC_SUBST(perl_dla) AC_MSG_CHECKING([for Perl dynamic loading compilation flags]) perl_cccdlflags="$($perl_prog -e 'use Config; print $Config{cccdlflags}')" case $perl_cccdlflags in " " ) x="none" ;; * ) x="$perl_cccdlflags" ;; esac AC_MSG_RESULT([$x]) AC_SUBST(perl_cccdlflags) AC_MSG_CHECKING([for Perl dynamic loading link flags]) perl_ccdlflags="$($perl_prog -e 'use Config; print $Config{ccdlflags}')" case $perl_os in *aix* ) perl_ccdlflags="$(echo $perl_ccdlflags | sed -e 's;-bE:perl.exp;-bE:${perl_archlib}/CORE/perl.exp;')" ;; esac case $perl_ccdlflags in " " ) AC_MSG_RESULT([none]) ;; * ) AC_MSG_RESULT([$perl_ccdlflags]) ;; esac AC_SUBST(perl_ccdlflags) AC_SUBST(perl_prog) AC_DEFINE_UNQUOTED(AC_perl_prog, "$perl_prog", Perl path) AC_DEFINE_UNQUOTED(AC_perl_vers, "$perl_vers", Perl version) AC_DEFINE_UNQUOTED(AC_perl_archlib, "$perl_archlib", Perl architecture directory) AC_DEFINE_UNQUOTED(AC_perl_libs, "$perl_libs", Perl library files) AC_DEFINE_UNQUOTED(AC_perl_dla, "$perl_dla", Perl dynamic loading support) AC_DEFINE_UNQUOTED(DO_NEWXS_STATIC_MODULES, $($perl_prog eperl_perl5_sm.pl), [dynamic module initialisation]) dnl # dnl # determine build tools and parameters dnl # AC_MSG_RESULT(CHECK: System Build Environment) AC_PROG_CC CFLAGS="$CFLAGS -Wall -Wextra -Wmissing-prototypes -Wmissing-declarations" AC_CHECK_PROG([AR],[ar],[ar],[]) AC_PROG_MAKE_SET AC_CHECK_LIB(pthread, pthread_join) AC_CHECK_FUNCS_ONCE(setproctitle) AC_CHECK_HEADERS([pwd.h grp.h sys/param.h]) AC_CONFIG_FILES([Makefile eperl.pod mod/Parse/ePerl.pm]) AC_OUTPUT >> libeperl.a # MakeMaker says "Warning (mostly harmless): No library found for -leperl" but then completely removes LIBS= if it doesn't see at least a file here (cd mod && exec $perl_prog Makefile.PL) test -s libeperl.a || rm -f libeperl.a ossp-eperl-ePerl_2_2_15/contrib/000077500000000000000000000000001470477324200166355ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/contrib/utils/000077500000000000000000000000001470477324200177755ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/contrib/utils/00README000066400000000000000000000002671470477324200210220ustar00rootroot00000000000000 del2del ............. changes the ePerl block delimiters in a file shtml2phtml ......... converts a (X)SSI file to ePerl format shtml2phtml.test..... testfile for shtml2phtml ossp-eperl-ePerl_2_2_15/contrib/utils/del2del000077500000000000000000000015111470477324200212340ustar00rootroot00000000000000#!/usr/bin/perl # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. ## del2del -- Change ePerl block delimiters if ($#ARGV < 4) { print STDERR "$0: ERROR: Bad arguments\n"; print STDERR "Usage: $0 oldBeginDel oldEndDel newBeginDel newEndDel files ...\n"; print STDERR "Example: $0 '' '<%' '%>' *.phtml\n"; exit 1 } $obd = quotemeta(shift @ARGV); $oed = quotemeta(shift @ARGV); $nbd = shift @ARGV; $ned = shift @ARGV; foreach $file (@ARGV) { print STDERR "Converting $file..."; rename("$file", "$file.old") or next; open(IN, "<", "$file.old"); open(OUT, ">", "$file"); while () { s|$obd|$nbd|go; s|$oed|$ned|go; print OUT $_; } close(OUT); close(IN); print STDERR "Done.\n"; } ossp-eperl-ePerl_2_2_15/contrib/utils/shtml2phtml000077500000000000000000000110641470477324200222030ustar00rootroot00000000000000#!/usr/bin/perl # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. ## shtml2phtml -- Convert (X)SSI script (.shtml) to ePerl script (.phtml) $time = time(); $deftimefmt = "%A, %d-%b-%y %T %Z"; $preamble = ""; $BD = ""; @CGIVARS = ( # standard CGI variables from CGI spec 'SERVER_SOFTWARE', 'SERVER_NAME', 'GATEWAY_INTERFACE', 'SERVER_PROTOCOL', 'SERVER_PORT', 'REQUEST_METHOD', 'PATH_INFO', 'PATH_TRANSLATED', 'SCRIPT_NAME', 'QUERY_STRING', 'REMOTE_HOST', 'REMOTE_ADDR', 'AUTH_TYPE', 'REMOTE_USER', 'REMOTE_IDENT', 'CONTENT_TYPE', 'CONTENT_LENGTH', 'HTTP_ACCEPT', 'HTTP_USER_AGENT', # additional CGI variables from Apache mod_rewrite 'SCRIPT_FILENAME', 'SCRIPT_URL', ); sub add_to_preamble ($) { my ($cmd) = @_; $x = quotemeta($cmd); if ($preamble !~ m|$x|s) { $preamble .= $cmd; } } sub interpolate_variable ($) { my ($name) = @_; # standard CGI variable if (grep("$name", @CGIVARS) eq $name) { return "\$ENV{'$name'}"; } # special ones elsif ($name eq 'LAST_MODIFIED') { add_to_preamble("use POSIX;\n"); add_to_preamble('$timefmt = "'.$deftimefmt.'";'."\n"); return 'strftime($timefmt, localtime((stat($ENV{"SCRIPT_SRC_FILE"}))[9]))', } elsif ($name eq 'DATE_LOCAL') { add_to_preamble("use POSIX;\n"); add_to_preamble('$timefmt = "'.$deftimefmt.'";'."\n"); return 'strftime($timefmt, localtime(time()))', } elsif ($name eq 'DATE_GMT') { add_to_preamble("use POSIX;\n"); add_to_preamble('$timefmt = "'.$deftimefmt.'";'."\n"); return 'strftime($timefmt, gmttime(time()))', } elsif ($name eq 'DOCUMENT_NAME') { return '\$ENV{"SCRIPT_SRC_FILE"};', } elsif ($name eq 'DOCUMENT_URI') { return '\$ENV{"SCRIPT_SRC_URL"};', } else { return '$'.$name; } } local $/; $in = <>; $out = ""; while ($in) { if ($in =~ m|(.*?)(.*)|s) { $out .= $1; $cmd = $2; $in = $3; } else { $out .= $in; last; } if ($cmd =~ m|config\s+timefmt="?(.+?)"?"\s*$|) { $out .= "$BD \$timefmt = \"$1\"; $ED"; } elsif ($cmd =~ m|echo\s+var="?(.+?)"?"\s*$|) { $out .= "$BD print " . &interpolate_variable($1) . "; $ED"; } elsif ($cmd =~ m|include\s+file="?(.+?)"?"\s*$|) { $out .= "\n#include \"$1\"\n"; } elsif ($cmd =~ m|include\s+virtual="?(.+?)"?"\s*$|) { $out .= "\n#include \"$1\"\n"; } elsif ($cmd =~ m|printenv\s*$|) { $out .= "$BD foreach \$k (sort(keys(\%ENV))) { print \"\$k=\$ENV{\$k}\\n\"; } $ED"; } elsif ($cmd =~ m|set\s+var="?(.+?)"?\s+value="?(.+?)"?\s*$|) { $out .= "$BD \$$1='$2'; $ED"; } elsif ($cmd =~ m|exec\s+cgi="?(.+?)"?\s*$|) { add_to_preamble("use LWP::Simple;\n"); $out .= "$BD print get('$1'); $ED"; } elsif ($cmd =~ m|exec\s+cmd="?(.+?)"?\s*$|) { $out .= "$BD print `$1`; $ED"; } elsif ($cmd =~ m|fsize\s+file="?(.+?)"?\s*$|) { $out .= "$BD print (stat(\"$1\"))[7]; $ED"; } elsif ($cmd =~ m|fsize\s+virtual="?(.+?)"?\s*$|) { $out .= "$BD print (stat(\"$1\"))[7]; $ED"; } elsif ($cmd =~ m|flastmod\s+file="?(.+?)"?\s*$|) { add_to_preamble("use POSIX;\n"); add_to_preamble('$timefmt = "'.$deftimefmt.'";'."\n"); $out .= "$BD print strftime(\$timefmt, (stat(\"$1\"))[9]); $ED"; } elsif ($cmd =~ m|flastmod\s+virtual="?(.+?)"?\s*$|) { add_to_preamble("use POSIX;\n"); add_to_preamble('$timefmt = "'.$deftimefmt.'";'."\n"); $out .= "$BD print strftime(\$timefmt, (stat(\"$1\"))[9]); $ED"; } elsif ($cmd =~ m|if\s+expr="?(.+?)"?\s*$|) { $expr = $1; $expr =~ s|=(\s/)|=~$1|g; $expr =~ s|!=(\s/)|!~$1|g; $expr =~ s|=\s|ne |g; $expr =~ s|!=\s|ne |g; $expr =~ s|&&|and|g; $expr =~ s|\|\||or|g; $out .= "\n#if $expr\n"; } elsif ($cmd =~ m|elif\s+expr="?(.+?)"?\s*$|) { $expr = $1; $expr =~ s|=(\s/)|=~$1|g; $expr =~ s|!=(\s/)|!~$1|g; $expr =~ s|=\s|ne |g; $expr =~ s|!=\s|ne |g; $expr =~ s|&&|and|g; $expr =~ s|\|\||or|g; $out .= "\n#elsif $expr\n"; } elsif ($cmd =~ m|else\s*$|) { $out .= "\n#else\n"; } elsif ($cmd =~ m|endif\s*$|) { $out .= "\n#endif\n"; } } print "$BD\n$preamble$ED\n"; print $out; ossp-eperl-ePerl_2_2_15/contrib/utils/shtml2phtml.test000066400000000000000000000006551470477324200231620ustar00rootroot00000000000000foo bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 bar1bar2 ossp-eperl-ePerl_2_2_15/eg/000077500000000000000000000000001470477324200155705ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/eg/00README000066400000000000000000000003651470477324200166140ustar00rootroot00000000000000 Here you can find some of the demo files from the ePerl webpages. They demonstrate typical situations for which ePerl can be used. The ones with extension .phtml can be used for testing with the stand-alone NPH/CGI program nph-eperl. ossp-eperl-ePerl_2_2_15/eg/demo.cgipm.phtml000066400000000000000000000025551470477324200206670ustar00rootroot00000000000000value if ($cookies{$cnt_name}); # increase the value, because its an access counter $cnt_value++; # create the new counter cookie and send it back to the browser my ($myname, $mypath) = ($ENV{'SCRIPT_SRC_URL'} =~ m%^http://(.+?)(?:|:\d+)(/.*)$%); my $cookie = new CGI::Cookie( -name => $cnt_name, -value => sprintf("%d", $cnt_value), -domain => $myname, -path => $mypath, -expires => '+24h' ); print "Set-Cookie: $cookie\n"; !> demo.cgipm

demo.cgipm

High-level HTTP programming with CGI.pm

This demonstrates how one can create complex HTTP headers like Netscape Cookies by programming them via Perl's CGI::Cookie module.

You have accessed this demo times now. This counter is stored in a cookie, so push your RELOAD button a few times to see the effect.

ossp-eperl-ePerl_2_2_15/eg/demo.env.phtml000066400000000000000000000010451470477324200203510ustar00rootroot00000000000000 demo.env

demo.env

Standard CGI Example: Environment

This prints out the CGI environment provided by the Webserver as a sorted list consisting of key/value pairs.
ossp-eperl-ePerl_2_2_15/eg/demo.errout.phtml000066400000000000000000000006711470477324200211050ustar00rootroot00000000000000 demo.errout

ePerl error page: caused by output on STDERR

First pure text, then... ...and then again pure text.

ossp-eperl-ePerl_2_2_15/eg/demo.errsyn.phtml000066400000000000000000000006721470477324200211100ustar00rootroot00000000000000 demo.errsyn

demo.errsyn

ePerl error page: caused by a syntax error

ossp-eperl-ePerl_2_2_15/eg/demo.func.phtml000066400000000000000000000017751470477324200205260ustar00rootroot00000000000000 demo.func

demo.func

Perl Programming

This demonstrates the global scoping within a webpage by defining a Perl function in a first ePerl block and later calling this function in another ePerl block.

Local time is .

ossp-eperl-ePerl_2_2_15/eg/demo.html.phtml000066400000000000000000000014671470477324200205350ustar00rootroot00000000000000 demo.html

demo.html

High-level HTML programming with HTML::Stream

This demonstrates how one can use the HTML-Stream package from within ePerl to do high-level HTML programming. First, a programmed hyperlink to A(HREF=>"http://www.engelschall.com/sw/eperl/")-> t("the ePerl webarea")-> _A; !> .

Second, just t("plain text with umlaut characters: \n" ); !>.
These were automatically converted from ISO-Latin-1 encoding to HTML entities.

ossp-eperl-ePerl_2_2_15/eg/demo.image.phtml000066400000000000000000000035231470477324200206460ustar00rootroot00000000000000 ePerl: demo.env

demo.image

Graphics programming with GD

This demonstrates how you can create a webpage with an inlined GIF image which itself is generated on-the-fly from within this page. In other words: the image is part of the webpage source, too. The trick here is that the complete page is surrounded with an ePerl block and according to the QUERY_STRING the script either produces the page itself (pure HTML) or the image by programming it on-the-fly with the GD module. The link to the image is done via a self-referencing URL.

As an example, we present an on-the-fly generared GIF image showing the Web216 color palette (the "browser-safe" colors):

The Image

interlaced('true'); for (my $b = 0; $b <= 255; $b += 51) { for (my $r = 0; $r <= 255; $r += 51) { for (my $g = 0; $g <= 255; $g += 51) { my $x = (($b / 51) % 3)*60 + (60-($r / 51) * 10); my $y = (($b / 51) < 3 ? 0 : 1)*60 + (60-($g / 51) * 10); my $col = $im->colorAllocate($r,$g,$b); $im->rectangle($x, $y, $x+9, $y+9, $col); $im->fill($x+2, $y+2, $col); } } } my $C = $im->gif; print "Content-type: image/gif\n"; printf "Content-length: %d\n", length($C); print "\n"; print $C; } !> ossp-eperl-ePerl_2_2_15/eg/demo.lwp.phtml000066400000000000000000000014011470477324200203570ustar00rootroot00000000000000 demo.lwp

demo.lwp

High-level Network programming with LWP::Simple

This demonstrates how one can use the LWP::Simple package (from libwww-perl) from within ePerl to retrieve a file via HTTP. As an example the ePerl distribution README file is fetched from http://www.engelschall.com/sw/eperl/distrib/eperl-SNAP/.

And here comes the file:
ossp-eperl-ePerl_2_2_15/eg/demo.net.phtml000066400000000000000000000021351470477324200203500ustar00rootroot00000000000000 demo.net

demo.net

Low-level Network programming with Net::FTP

This demonstrates how one can use the Net::FTP package (from libnet) from within ePerl to retrieve a file via FTP. As an example the ePerl distribution README file is fetched from ftp://ftp.engelschall.com/sw/ while the current filename (ePerl version!) is determined on-the-fly.

And here comes the file: 

new("ftp.engelschall.com");
$ftp->login("ftp", "demo.ftp\@");
$ftp->cwd("/sw");
my ($f) = grep(/^eperl-.*\.readme$/, $ftp->ls("eperl-*.readme"));
$ftp->get($f, $tmpfile);
$ftp->quit;

#   read the temporary file into current page
open(FP, "<", "$tmpfile");
while () {
    print $_;
}
close(FP);
unlink($tmpfile);
!>
ossp-eperl-ePerl_2_2_15/eg/demo.pp.phtml000066400000000000000000000012621470477324200202010ustar00rootroot00000000000000 demo.pp

demo.pp

Special feature: the ePerl preprocessor

This demonstrates how one can use the ePerl preprocessor. We again (as in demo.lwp) retrieve a file via HTTP. As an example the ePerl distribution README file is fetched from http://www.engelschall.com/sw/eperl/distrib/eperl-SNAP/.

And here comes the file: 

#sinclude "http://www.engelschall.com/sw/eperl/distrib/eperl-SNAP/README"
ossp-eperl-ePerl_2_2_15/eg/demo.table.phtml000066400000000000000000000016421470477324200206530ustar00rootroot00000000000000 demo.table

demo.table

Low-level HTML programming

Instead of writing down the complex HTML table constructs for the 1x1 chart we program it with the control structures of Perl language.

"; for (my $i=1; $i <= $end; $i++) { print ""; } print ""; # side bar and content print"\n"; for (my $i=1; $i <= $end; $i++) { print ""; for (my $j=1; $j<= $end; $j++) { print ""; } print"\n"; } !>
x$i
$i", $i*$j, "

ossp-eperl-ePerl_2_2_15/eg/demo.text.phtml000066400000000000000000000005231470477324200205450ustar00rootroot00000000000000Content-type: text/plain demo.func Low-level HTTP programming This demonstrates how one can prefix the ePerl file with plain HTTP headers which are directly put into the HTTP response header block. ossp-eperl-ePerl_2_2_15/eperl.h000066400000000000000000000063051470477324200164610ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #ifndef EPERL_PROTO_H #define EPERL_PROTO_H 1 #include "config.h" #include #include #include #include #include #include #include #include #include #include #include #include #ifdef HAVE_SYS_PARAM_H #include #endif #ifndef O_PATH #define O_PATH O_RDONLY #endif #define EX_OK 0 #define EX_FAIL 1 #define EX_USAGE 64 /* command line usage error */ #define EX_IOERR 74 /* input/output error */ #define CU(returncode) do { rc = returncode; goto CUS; } while(0) /* eperl_main.c */ enum runtime_mode { MODE_UNKNOWN = 1, MODE_FILTER = 2, MODE_CGI = 4, MODE_NPHCGI = 8, }; extern void PrintError(enum runtime_mode mode, const char *scripturl, const char *scriptfile, char **errstr, size_t *errstrN, const char *str, ...) __attribute__((format(printf, 6, 7))); /* eperl_parse.c */ extern bool ePerl_line_continuation; extern char *ePerl_ErrorString; extern void *memcasemem(const void *buf, size_t n, const void *str, size_t len); extern void ePerl_SetError(const char *str, ...) __attribute__((format(printf, 1, 2))); extern char *ePerl_Sprinkled2Plain(const char *cpBuf, const char *ePerl_begin_delimiter, const char *ePerl_end_delimiter, bool ePerl_case_sensitive_delimiters, bool ePerl_convert_entities); /* eperl_pp.c */ extern char *ePerl_PP(char *cpBuf, const char *const *cppINC, size_t cppINCLen, const char *ePerl_begin_delimiter, const char *ePerl_end_delimiter, bool ePerl_case_sensitive_delimiters); /* eperl_sys.c */ extern void putenvf(const char *fmt, ...) __attribute__((format(printf, 1, 2))); extern void IO_redirect_stdout(int fd); extern void IO_redirect_stderr(int fd); extern void IO_restore_stdout(void); extern void IO_restore_stderr(void); enum tmpfile_id { tmpfile_stdin, tmpfile_script, tmpfile_stdout, tmpfile_cnt }; struct tmpfile { char *filename; int fd; }; extern struct tmpfile mytmpfile(enum tmpfile_id id); extern void remove_mytmpfiles(void); extern bool ePerl_CopyFILE(FILE *from, FILE *to); extern bool ePerl_ReadSourceFile(const char *filename, char **cpBufC, size_t *nBufC); extern void ePerl_SubstErrorLog(char **cpBuf, size_t *nBuf, const char *replace, const char *with); /* eperl_http.c */ extern size_t HTTP_PrintResponseHeaders(const char *cpBuf); extern bool HTTP_HeadersExists(const char *cpBuf); extern FILE *HTTP_openURLasFP(const char *url); /* eperl_perl5.c */ extern void Perl5_RememberScalar(char *str); extern int Perl5_Run(int myargc, char **myargv, enum runtime_mode mode, bool fCheck, bool keepcwd, int *cwd, const char *sourcedir, const char *source, const char *perlscript, char **stdoutBuf, size_t *nstdoutBuf); extern const size_t ePerl_README_size; extern const size_t ePerl_LICENSE_size; extern const size_t ePerl_LOGO_size; extern const size_t ePerl_POWERED_size; extern const uint8_t ePerl_README[]; extern const uint8_t ePerl_LICENSE[]; extern const uint8_t ePerl_LOGO[]; extern const uint8_t ePerl_POWERED[]; #endif /* EPERL_PROTO_H */ ossp-eperl-ePerl_2_2_15/eperl.pod.in000066400000000000000000000655671470477324200174400ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1996,1997 Ralf S. Engelschall, All rights reserved. =encoding UTF-8 =head1 NAME ePerl - Embedded Perl 5 Language =head1 SYNOPSIS B [B<-d> I=I] [B<-D> I=I] [B<-B> I] [B<-E> I] [B<-i>] [B<-m> I] [B<-o> I] [B<-k>] [B<-I> I] [B<-P>] [B<-C>] [B<-L>] [B<-x>] [B<-T>] [B<-w>] [B<-c>] [I] B B<-r>|B<-l>|B<-v>|B<-V> =head1 DESCRIPTION =head2 Abstract ePerl interprets a text file sprinkled with Perl 5 program statements by evaluating the Perl 5 code while copying the plain text data verbatim. It can operate in various ways: As a stand-alone Unix filter or integrated Perl 5 module for general file generation tasks and as a powerful Webserver scripting language for dynamic HTML page programming. =head2 Introduction The B program is the I interpreter. This really is a full-featured Perl 5 interpreter, but with a different calling environment and source file layout than the default Perl interpreter (B). It is designed for general text file generation with the philosophy of I the Perl 5 program code into the data instead of the usual way where you embed the data into a Perl 5 program (usually by quoting the data and using them via C statements). So, instead of writing a plain Perl script like #!/usr/bin/perl print "foo bar\n"; print "baz quux\n"; for ($i = 0; $i < 10; $i++) { print "foo #${i}\n"; } print "foo bar\n"; print "baz quux\n"; you can write it now as an ePerl script: #!@prefix@/bin/eperl foo bar baz quux <: for ($i = 0; $i < 10; $i++) { print "foo #${i}\n"; } :> foo bar baz quux Although the ePerl variant has a different source file layout, the semantic is the same, i.e. both scripts create exactly the same resulting data on C. =head2 Intent ePerl is simply glue code which combines the programming power of the Perl 5 interpreter library with an embedding trick: it converts the source file into a valid Perl script which then gets I evaluated by only one internal instance of the Perl 5 interpreter. To achieve this, ePerl translates all plain code into (escaped) Perl 5 strings placed into F constructs while passing through all embedded native Perl 5 code. This amounts to the same operation as one would do when writing a plain Perl generation script. Due to the nature of such sprinkled code, ePerl is really the better approach when the generated text contains really more static than dynamic data. Or in other words: I Do not use it when generating pure dynamic data. There it brings no advantage to the ordinary program code of a plain Perl script. So, the static part should be at least 60% or the advantage becomes a disadvantage. ePerl in its origin was actually designed for an extreme situation: as a webserver scripting-language for on-the-fly HTML page generation. Here you have the typical case that usually 90% of the data consists of pure static HTML tags and plain text while just the remaining 10% are programming constructs which dynamically generate more markup code. This is the reason why ePerl beside its standard Unix filtering runtime-mode also supports the CGI/1.1 and NPH-CGI/1.1 interfaces. =head2 Embedded Perl Syntax Practically you can put any valid Perl constructs inside the ePerl blocks the used Perl 5 interpreter library can evaluate. But there are some important points you should always remember and never forget when using ePerl: =over 4 =item I<1. Delimiters are always discarded.> Trivially to say, but should be mentioned at least once. The ePerl block delimiters are always discarded and are only necessary for ePerl to recognize the embedded Perl constructs. They are never copied to the final output. =item I<2. Generated content has to go to C.> Although you can define subroutines, calculate some data, etc. inside ePerl blocks, only data which is explicitly written to the C filehandle is expanded. In other words: When an ePerl block does not generate content on C, it is entirely replaced by an empty string in the final output. But when content is generated it is put at the point of the ePerl block in the final output. Usually content is generated via pure C constructs which implicitly use C when no filehandle is given. =item I<3. Generated content on C always leads to an error.> Whenever content is generated on the C filehandle, ePerl displays an error (including the STDERR content). Use this to exit on errors while passing errors from ePerl blocks to the calling environment. =item I<4. Last semicolon.> Because of point 6 (below) and the fact that most of the users don't have the internal ePerl block translations in mind, ePerl is smart about the last semicolon. Usually every Perl block has to end with the semicolon of the last command. <: cmd; ...; cmd; :> But when the last semicolon is missing it is automatically added by ePerl, i.e. <: cmd; ...; cmd :> is also correct syntax. But sometimes it is necessary to force ePerl I to add the semicolon. Then you can add a C<_> (underscore) as the last non-whitespace character in the block to force ePerl to leave the final semicolon. Use this for constructs like the following <: if (...) { _:> foo <: } else { _:> bar <: } :> where you want to spread a Perl directive over more ePerl blocks. =item I<5. Shorthand for C-only blocks.> Because most of the time ePerl is used just to interpolate variables, e.g. <: print $VARIABLE; :> it is useful to provide a shortcut for this kind of constructs. So ePerl provides a shortcut via the character C<=>. When it immediately (no whitespaces allowed here) follows the begin delimiter of an ePerl block, a C statement is implicitly generated, i.e. the above block is equivalent to <:=$VARIABLE:> =item I<6. Special end-of-line discard command for ePerl blocks.> ePerl provides a special discard command named C which discards all data up to and including the following newline character when directly followed an end block delimiter. Usually when you write foo <: $x = 1; :> quux the result is foo quux because ePerl always preserves code around ePerl blocks, even just newlines. But when you write foo <: $x = 1; :>// quux the result is foo quux =item I<7. Restrictions in parsing.> Perl is a rich language, but a horrible one to parse. Perhaps you've heard "Only F can parse I". The implication of this is that ePerl never tries to parse the ePerl blocks itself. It entirely relies on the Perl interpreter library, because it is the only instance which can do this without errors. But the problem is that ePerl at least has to recognize the begin and end positions of those ePerl blocks. There are two ways: It can either look for the end delimiter while parsing, but at least recognize quoted strings (where the end delimiter gets treated as pure data). Or it can just move forward to the next end delimiter and say that it can not occur inside Perl constructs. In ePerl 2.0 the latter was used, while in ePerl 2.1 the former was taken because a lot of users wanted it this way while using bad end delimiters like C>. But actually the author has again revised its opinion in ePerl 2.2 and decided to finally use latter approach. Because while the first one allows more trivial delimiters (which itself is not a really good idea), it fails when constructs like C etc. are used inside ePerl blocks. And it is easier to escape end delimiters inside Perl constructs (for instance via backslashes in quoted strings) than rewrite complex Perl constructs to use even numbers of quotes. So, whenever your end delimiter also occurs inside Perl constructs you have to some-how escape it. =item I<8. HTML entity conversion.> Because one of ePerl's usage is as a server-side scripting-language for HTML pages, there is a common problem in conjunction with HTML editors. They cannot know ePerl blocks, so when you enter those blocks inside the editors they usually encode some characters with the corresponding HTML entities. The problem is that this encoding leads to invalid Perl code. ePerl provides the B<-C> option (q.v.) for decoding these entities to CP-1252, which is automatically turned on in CGI modes. =back =head2 Runtime Modes ePerl can operate in three different runtime modes: =over 4 =item I This is the default operation mode when used as a generation tool from the Unix shell or as a batch-processing tool from within other programs or scripts: $ eperl [options] - < inputfile > outputfile $ eperl [options] inputfile > outputfile $ eperl [options] -o outputfile - < inputfile $ eperl [options] -o outputfile inputfile As you can see, ePerl can be used in any combination of STDIO and external files. Additionally there are two interesting variants of using this mode. First, you can put ePerl in the shebang to implicitly select it as the interpreter for your script, similar to the way you are used to with the plain Perl interpreter: #!@prefix@/bin/eperl [options] foo <: print "bar"; :> quux Second, you can use ePerl in conjunction with the shell I technique from within your shell programs: #!/bin/sh ... eperl [options] - < quux EOS ... If you need to generate shell or other scripts with ePerl, i.e. you need a shebang line in the output of ePerl, you have to add a shebang line containing e.g. C<#!@prefix@/bin/eperl> first, because ePerl will strip the first line from the input if it is a shebang line. For example: #!@prefix@/bin/eperl #!/bin/sh echo <: print "quux"; :> will result in the following output: #!/bin/sh echo quux Alternatively you can add a preprocessor comment in the first line: #c This is a comment to preserve the shebang line in the following line #!/bin/sh echo <: print "quux"; :> And finally you can use ePerl directly from within Perl programs by the use of the Parse::ePerl(3) package (assuming that you have installed this also): #!/path/to/perl ... use Parse::ePerl; ... $script = < quux EOT ... $result = Parse::ePerl::Expand({ Script => $script, Result => \$result, }); ... print $result; ... See Parse::ePerl(3pm) for more details. =item I This is the runtime mode where ePerl uses the CGI/1.1 interface of a webserver when used as a server-side scripting language. ePerl enters this mode automatically when the CGI/1.1 environment variable C is set and its or the scripts filename does I begin with the NPH prefix "F". In this runtime mode it prefixes the resulting data with HTTP/1.0 (default) or HTTP/1.1 (if identified by the webserver) compliant response header lines. ePerl also recognizes HTTP header lines at the beginning of the script's generated data, for instance you can generate your own HTTP headers with ... But notice that while you can output arbitrary headers, most webservers restrict the headers which are accepted via the CGI/1.1 interface. Usually you can provide only a few specific HTTP headers like C or C. If you need more control you have to use the NPH-CGI/1.1 interface mode. The default HTTP status is "200 OK". If your script's output starts with an HTTP status line (C (or C)), that line is used instead. Additionally ePerl provides a useful feature in this mode: It can switch its UID/GID to the owner of the script if the set-UID bit is set (see I). There are two commonly known ways of using this CGI/1.1 interface mode on the Web. First, you can use it to explicitly transform plain HTML files into CGI/1.1 scripts with a shebang (see above). For an Apache webserver, just put the following line as the first line of the file: #!@prefix@/bin/eperl -mc Then rename the script from F to F and set mark it executable: $ mv file.html file.cgi $ chmod a+rx file.cgi Now make sure that Apache accepts F as a CGI program by enabling CGI support for the directory where F resides. For this add the line Options +ExecCGI to the F<.htaccess> file in this directory. Finally make sure that Apache really recognizes the extension F<.cgi>. Perhaps you additionally have to add the following line to your F file: AddHandler cgi-script .cgi Now you can use F instead of F and take advantage of the achieved programming capability by bristling F with your Perl blocks (or the transformation into a CGI script would have been useless). Alternatively (or even additionally) a webmaster can enable ePerl support in a more seamless way by configuring ePerl as a real implicit server-side scripting language. This is done by assigning a MIME-type to the various valid ePerl file extensions and forcing all files with this MIME-type to be internally processed via the ePerl interpreter. You can accomplish this for Apache by adding the following to your F file AddType application/x-httpd-eperl .phtml .eperl .epl Action application/x-httpd-eperl /internal/cgi/eperl ScriptAlias /internal/cgi /path/to/apache/cgi-bin and creating a copy of the F program in your CGI-directory: $ cp -p @prefix@/bin/eperl /path/to/apache/cgi-bin/eperl Now all files with the extensions F<.phtml>, F<.eperl> and F<.epl> are automatically processed by the ePerl interpreter. There is no need for a shebang or any locally-enabled CGI mode. One final hint: When you want to test your scripts offline, just run them with forced CGI/1.1 mode from your shell. But make sure you prepare all environment variables your script depends on, like C or C: $ export QUERY_STRING="key1=value1&key2=value2" $ eperl -mc file.phtml =item I This runtime mode is a special variant of the CGI/1.1 interface mode, because most webservers (e.g. Apache) provide it for special purposes. NPH stands for I and is usually used by the webserver when the filename of the CGI program is prefixed with C. In this mode the webserver does no processing on the HTTP response headers and no buffering of the resulting data, i.e. the CGI program actually has to provide a complete HTTP response itself. The advantage is that the program can generate arbitrary HTTP headers or MIME-encoded multi-block messages. So, above we have renamed the file to F which restricted us a little bit. When we alternatively rename F to F and force the NPH-CGI/1.1 interface mode via option B<-mn> then this file becomes a NPH-CGI/1.1 compliant program under Apache and other webservers. Now our script I provide its own HTTP response (it doesn't I to, because ePerl provides a default one if it is absent). #!/path/to/bin/eperl -mn ... Expectedly, this can be also used with the implicit Server-Side Scripting Language technique. Put AddType application/x-httpd-eperl .phtml .eperl .epl Action application/x-httpd-eperl /internal/cgi/nph-eperl ScriptAlias /internal/cgi /path/to/apache/cgi-bin into your F and run the command $ cp -p @prefix@/bin/eperl /path/to/apache/cgi-bin/nph-eperl from your shell. I =back =head2 Security When you are installing ePerl as a CGI/1.1 or NPH-CGI/1.1 compliant program (see above for detailed description of these modes) via $ cp -p @prefix@/bin/eperl /path/to/apache/cgi-bin/eperl $ chown root /path/to/apache/cgi-bin/eperl $ chmod u+s /path/to/apache/cgi-bin/eperl or $ cp -p @prefix@/bin/eperl /path/to/apache/cgi-bin/nph-eperl $ chown root /path/to/apache/cgi-bin/nph-eperl $ chmod u+s /path/to/apache/cgi-bin/nph-eperl i.e. with set-UID bit enabled for the B user, ePerl can switch to the UID/GID of the I. Although this is a very useful feature for script programmers (because one no longer need to make auxiliary files world-readable and temporary files world-writable!), it can be to risky for you when you are paranoid about security of set-UID programs. If so, just don't install ePerl set-UID! This is the reason why ePerl is by default only installed as a stand-alone program which never needs this feature. For those of us who decided that this feature is essential, ePerl tries really hard to make it secure. The following steps have to be successfully passed before ePerl actually switches its UID/GID (in this order): =over 4 =item 1. The script has to match the following extensions: F<.html>, F<.phtml>, F<.eperl>, F<.ephtml>, F<.epl>, F<.pl>, F<.cgi> =item 2. The UID of the calling process has to be a valid UID, i.e. it has to be found in passwd(5) =item 3. The UID of the calling process has to match the following users: @with_allowed_caller_uids@ =item 4. The UID of the script owner has to be a valid UID, i.e. it has to be found in passwd(5) =item 5. The GID of the script group has to be a valid GID, i.e. it has to be found in group(5) =item 6. The script has to stay below the owner's home directory =back B>. Additionally (if C was defined to C in F, which is not the default) ePerl can totally stop processing and display its error page. This is for the really paranoid webmasters. Per default when any step failed the UID/GID switching is just disabled, but ePerl goes on with processing. Alternatively you can disable some steps at compile time. See F. I reset to the real UID/GID, regardless of the mode.> =head2 ePerl Preprocessor ePerl provides its own preprocessor, similar to the C preprocessor, which is either enabled manually via option B<-P>, or automatically when ePerl runs in (NPH-)CGI mode. The following directives are supported: =over 4 =item C<#include I> The contents of I, which can be either a relative or absolute path or a fully qualified HTTP URL, are read and preprocessed recursively. An absolute path is opened directly, relative paths are tried in the working directory and then in directories given by B<-I>. An HTTP URL is retrieved via a HTTP/1.0 request on the network, and 301/303 redirects are followed. While ePerl strictly preserves the line numbers when removing sprinklings to yield the plain Perl format, the preprocessor can't do this for this directive. So, line numbers in error messages will be wrong. The security implications are obvious: This can run arbitrary code. You probably shouldn't use this if you don't implicitly trust the reply. C<#sinclude> is appropriate then. =item C<#sinclude I> This is just like C<#include>, but all delimiters are removed. Thus, I is reduced to only data, and no code. =item C<#if I>, C<#elsif I>, C<#else>, C<#endif> These implement a C-preprocessor-style C<#if>/C<#else>/C<#endif> construct, but I is a Perl expression evaluated at run-time. These are converted as follows (where F/F are the delimiters): #if expr → BD if (expr) { _ ED// #elsif expr → BD } elsif (expr) { _ ED// #else → BD } else { _ ED// #endif → BD } _ ED// =item C<#c> Comment, discards everything up to and including the newline. =back =head2 Provided Functionality You can put really I Perl code into the ePerl blocks which are valid to the Perl interpreter ePerl was linked with. ePerl does I provide any special functionality inside these ePerl blocks, because Perl is already sophisticated enough ;-) Because you can use any valid Perl code you can use all available Perl 5 modules, even those which use shared objects. The Comprehensive Perl Archive Network L provides packages for use both from within plain Perl scripts I ePerl scripts. C works as-expected. =head1 OPTIONS =over 4 =item B<-d> I=I Sets a Perl variable in the package C
which can be referenced via C<$name> or more explicitly via C<$main::name>. This is equivalent to adding to the beginning of I. This option can occur more than once. =item B<-D> I=I Sets environment variable I to I, which can be referenced via C<$ENV{'I'}>. This is equivalent to just running $ name=value eperl ... This option can occur more than once. =item B<-B> I =item B<-E> I Set the Perl block begin and end delimiter strings. Default delimiters are C?> & C> for CGI modes and C:> & C<:E> otherwise. These may be of interest: =over 4 =over 4 =item C:> & C<:E> (the default ePerl stand-alone filtering mode delimiters) =item C?> & C> (the default ePerl CGI interface mode delimiters) =item Cscript language='ePerl'E> & C/scriptE> (standard HTML scripting language style) =item Cscript type="text/eperl"E> & C/scriptE> (forthcoming HTML3.2+ aka Cougar style) =item CeperlE> & C/eperlE> (HTML-like style) =item C!--#eperl code='> & C<' --E> (NeoScript and SSI style) =item C?> & C> (PHP/FI style; but this no longer recommended because it can lead to parsing problems. Should be used only for backward compatibility to old ePerl versions 1.x). =back =back =item B<-i> Forces the begin and end delimiters to be searched case-insensitively. Use this when you are using delimiters like CePerlE>...C/ePerlE> or other more textual ones. =item B<-m> I Forces ePerl to act in a specific runtime mode: stand-alone filter (B<-mf>), the CGI/1.1 interface (B<-mc>), or the NPH-CGI/1.1 interface (B<-mn>). =item B<-o> I Write to F instead of F (C<-> specifies F explicitly.) This path is relative to the directory containing I in the CGI modes. =item B<-k> Don't change the working directory. By default, ePerl will change to the directory containing I. =item B<-x> Output the internally created Perl script to the console (F) before executing it. =item B<-I> I Specifies a directory which where C<#include> and C<#sinclude> files are searched, and which is to be added to Perl C<@INC>. This option can occur more than once. =item B<-P> Enable the special ePerl Preprocessor (see above). This option is enabled for all CGI modes automatically. =item B<-C> This enables the HTML entity conversion for ePerl blocks. This option is automatically forced in CGI modes. The solved problem here is the following: When you use ePerl as a server-side-scripting-language for HTML pages and you edit your ePerl source files via a HTML editor, it's likely that it translates some entered characters into HTML entities, like C> to C<<>. This leads to invalid Perl code inside ePerl blocks. Using this option, the ePerl parser automatically converts all entities found inside ePerl blocks back to plain CP-1252 characters, so the Perl interpreter again receives valid code blocks. =item B<-L> This enables the line continuation character C<\> (backslash) outside ePerl blocks. With this option you can spread one-line data over more lines. But use with care: This option changes your data (outside ePerl blocks). Usually ePerl really pass through all surrounding data as raw data. With this option the newlines have new semantics. =item B<-T> This enabled Perl's I where the Perl interpreter takes special precautions called "taint checks" to prevent both obvious and subtle traps. See perlsec(1) for more details. =item B<-w> This enables Warnings where the Perl interpreter produces some lovely diagnostics. See perldiag(1) for more details. =item B<-c> This only runs a syntax check, like C. =item B<-r> This copies the ePerl README to F. =item B<-l> This copies the ePerl licences to F. =item B<-v> This shows ePerl version information to F. =item B<-V> B<-v> + shows the Perl compilation parameters. =back =head1 ENVIRONMENT =head2 Used Variables =over 4 =item C This CGI/1.1 variable is used to determine the source file when ePerl operates as a NPH-CGI/1.1 program under the environment of a webserver. =back =head2 Provided Variables =over 4 =item C The absolute pathname of the script. Use this when you want to directly access the script from within itself, for instance to do stat(2) and other calls. =item C The directory part of C. Use this one when you want to directly access other files residing in the same directory as the script, for instance to read config files, etc. =item C The filename part of C. Use this one when you need the basename of the script, for instance for relative self-references through URLs. =item C The fully-qualified URL of the script. =item C The directory part of C. =item C The filename part of C. Same as C, but provided for consistency. =item C The filesize of the script, in bytes. =item C The last modification time of the script, in seconds since epoch. =item C The last modification time of the script, in ctime(3) format (I). =item C The last modification time of the script, in German format (I). =item C The username of the script owner or C>. =item C The ePerl identification string. =item C The identification string of the Perl interpreter. =back =head2 Provided Built-In Images The following built-in images can be accessed via URL CIC<.gif>: =over 4 =item C The standard ePerl logo. Please do not include this one on your website. =item C The "I" logo. Feel free to use this on your website. =back =head1 AUTHOR Ralf S. Engelschall rse@engelschall.com www.engelschall.com =head1 SEE ALSO Parse::ePerl(3). Web-References: Perl: perl(1), http://www.perl.com/ ePerl: eperl(1), http://sr.ht/~nabijaczleweli/ossp Apache: httpd(8), http://www.apache.org/ =cut ossp-eperl-ePerl_2_2_15/eperl_http.c000066400000000000000000000164751470477324200175240ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" #include #include #include #define min(a, b) ((a) < (b) ? (a) : (b)) /* ** check if the line is a valid HTTP header line */ static bool HTTP_IsHeaderLine(const char *beg, size_t len) { char *colon = memchr(beg, ':', len); if (!colon) return false; size_t validlen = strspn(beg, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890-_"); return (size_t)(colon - beg) == validlen; } /* ** check if there a particular HTTP headerline exists */ static bool HTTP_HeaderLineExists(const char *cpBuf, const char *name) { size_t n = strlen(name); const char *cp2 = NULL, *cp2a; if ((cp2a = strstr(cpBuf, "\n\n")) != NULL) cp2 = cp2a; if ((cp2a = strstr(cpBuf, "\r\n\r\n")) != NULL && (cp2 == NULL || cp2a < cp2)) cp2 = cp2a; if (cp2 != NULL) { for (const char *cp1 = cpBuf; cp1 < cp2-1; ) { const char *cp3 = strchr(cp1, '\n'); if ((size_t)(cp3-cp1) > n+1 && HTTP_IsHeaderLine(cp1, cp3-cp1)) if (strncasecmp(cp1, name, n) == 0) return true; cp1 = cp3+1; } return false; } return false; } /* ** print a standard HTTP reponse of header lines */ size_t HTTP_PrintResponseHeaders(const char *cpBuf) { size_t skip = 0; const char *statend; if ( (!strncmp(cpBuf, "HTTP/1.0 ", strlen("HTTP/1.0 ")) || !strncmp(cpBuf, "HTTP/1.1 ", strlen("HTTP/1.1 "))) && (cpBuf[ 9] >= '1' && cpBuf[ 9] <= '5') && (cpBuf[10] >= '0' && cpBuf[10] <= '9') && (cpBuf[11] >= '0' && cpBuf[11] <= '9') && (cpBuf[12] == ' ') && ((statend = strchr(cpBuf + 12, '\n')) != NULL)) { /* found HTTP status code */ printf("%.*s\r\n", (int)(statend - cpBuf - (*(statend - 1) == '\r')), cpBuf); skip = statend - cpBuf + 1; } else { /* no HTTP status code */ printf("%s 200 OK\r\n", getenv("SERVER_PROTOCOL") ?: "HTTP/1.0"); } if (!HTTP_HeaderLineExists(cpBuf, "Server")) printf("Server: %s ePerl/%s Perl/%s\r\n", getenv("SERVER_SOFTWARE") ?: "unknown-server/0.0", EPERL_VERSION_SHORT, AC_perl_vers); if (!HTTP_HeaderLineExists(cpBuf, "Date")) printf("Date: %.24s\r\n", ctime(&(time_t){time(NULL)})); if (!HTTP_HeaderLineExists(cpBuf, "Connection")) printf("Connection: close\r\n"); return skip; } /* ** check if there is a valid HTTP header */ bool HTTP_HeadersExists(const char *cpBuf) { const char *cp2 = NULL, *cp2a; if ((cp2a = strstr(cpBuf, "\n\n")) != NULL) cp2 = cp2a; if ((cp2a = strstr(cpBuf, "\r\n\r\n")) != NULL && (cp2 == NULL || cp2a < cp2)) cp2 = cp2a; if (cp2 != NULL) { for (const char *cp1 = cpBuf; cp1 < cp2-1; ) { const char *cp3 = strchr(cp1, '\n'); if (!HTTP_IsHeaderLine(cp1, cp3 - cp1)) return false; cp1 = cp3+1; } return true; } return false; } /* ** extracts the host name from an url */ struct slice { char *data; size_t len; }; static struct slice HTTP_HostOfURL(char *url) { char *cps = strstr(url, "//") + 2, *cpe; for (cpe = cps; *cpe != '/' && *cpe != ':' && *cpe != '\0'; cpe++) ; return (struct slice){ .data = cps, .len = cpe-cps }; } /* ** extracts the port from an url */ static struct slice HTTP_PortOfURL(char *url) { char *cps = strstr(url, "//") + 2, *cpe; for ( ; *cps != '/' && *cps != ':' && *cps != '\0'; cps++) ; if (*cps == ':') { cps++; for (cpe = cps; *cpe != '/' && *cpe != '\0'; cpe++) ; return (struct slice){ .data = cps, .len = cpe-cps }; } else return (struct slice){ .data = "80", .len = 2 }; } /* ** extracts path from an url */ static const char *HTTP_FileOfURL(const char *url) { return (strchr(strstr(url, "//") + 2, '/') ?: "/") + 1; } /* ** open an URL as a file descriptor */ FILE *HTTP_openURLasFP(const char *url_arg) { struct addrinfo *ai; char buf[8 * 1024]; struct slice host, port; const char *file; char *cp; int s; char *url = (char *)url_arg; bool url_rw = false; redirected: host = HTTP_HostOfURL(url); port = HTTP_PortOfURL(url); file = HTTP_FileOfURL(url); /* get the host name */ if (host.data[host.len]) { if (!url_rw) { host.len = min(sizeof(buf) - 128, host.len); host.data = memcpy(buf, host.data, host.len); } host.data[host.len] = '\0'; } if (port.data[port.len]) { if (!url_rw) { port.len = min(126, port.len); port.data = memcpy(buf + sizeof(buf) - 127, port.data, port.len); } port.data[port.len] = '\0'; } if (getaddrinfo(host.data, port.data, NULL, &ai) != 0) return NULL; if ((s = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)) == -1) { freeaddrinfo(ai); return NULL; } if (connect(s, ai->ai_addr, ai->ai_addrlen) == -1) { freeaddrinfo(ai); close(s); return NULL; } freeaddrinfo(ai); /* send HTTP/1.0 request */ FILE *fp = fdopen(s, "r+"); fprintf(fp, "GET /%s HTTP/1.0\r\n" "Host: %s:%s\r\n" "User-Agent: ePerl/%s\r\n" "\r\n", file, host.data, port.data, EPERL_VERSION_SHORT); fflush(fp); /* read the HTTP response line and check for 200 OK response */ if (fgets(buf, sizeof(buf), fp) == NULL) { fclose: fclose(fp); return NULL; } if (strncmp(buf, "HTTP/1.", 7) || (buf[7] != '0' && buf[7] != '1')) goto fclose; for (cp = buf+8; *cp == ' ' || *cp == '\t'; cp++) ; if (strncmp(cp, "200", 3 /* OK */) != 0) { if (strncmp(cp, "301", 3 /* MOVED PERMANENTLY */) != 0 || strncmp(cp, "302", 3 /* MOVED TEMPORARILY */) != 0 ) { /* we try to determine the new URL from the HTTP header 'Location' and restart from the beginning if an URL is found */ while (fgets(buf, sizeof(buf), fp) != NULL) { if ((*buf == '\n' && *(buf+1) == '\0') || (*buf == '\n' && *(buf+1) == '\r' && *(buf+2) == '\0') || (*buf == '\r' && *(buf+1) == '\n' && *(buf+2) == '\0')) break; if (strncasecmp(buf, "Location:", 9) == 0) { char *newurl = buf + 9; newurl += strspn(newurl, " \t"); newurl[strcspn(newurl, " \t\r\n")] = '\0'; fclose(fp); if (strncmp(newurl, "http://", 7)) return NULL; url = newurl; url_rw = true; goto redirected; } } return NULL; } goto fclose; } /* now read until a blank line, i.e. skip HTTP headers */ while (fgets(buf, sizeof(buf), fp) != NULL) { if ((*buf == '\n' && *(buf+1) == '\0') || (*buf == '\n' && *(buf+1) == '\r' && *(buf+2) == '\0') || (*buf == '\r' && *(buf+1) == '\n' && *(buf+2) == '\0')) break; } /* return the (still open) FILE pointer */ return fp; } ossp-eperl-ePerl_2_2_15/eperl_logo.gif000066400000000000000000000136351470477324200200230ustar00rootroot00000000000000GIF89al ̙333ff3fffff3333f̙̙̙f3f̙3̙ff3f333ff̙ff̙f333̙ff3f3̙̙33f3ff33ffZwZwtGtGtGG tvH! ?,l@pH,Ȥrl:ШtJZجv+ xԯ A`p8ttq|Cq ~`DBdc o~V^ ^qoxxk l o H^ d݊ebܗޮ뀕掐ݾ0Փċ7 9UjSy5) @W&[06x(Ʀ%eh@kf"ƥϟP6Hu,i,/:5Fj]VJ,E8&˖<]!(nx7/>@ Gˆ,ؕb5 +o"Eɟ | -ZwdJ `KV#BSnJ}%9؋| Xb^K Ǜ8xCAŀr,6#}#Pr8GӫP!-`섷GhO󽮌 Z1g\i rCA}IozGH\|cq]A{;- B&M88;b^z\_a>a_P1 p~hM&lG 7lP8ڍlhUQ_] ${aˈyyg~)ԣgFj$\>>ܥ?nA:&P؟P rjcQ, :E[`VBЩLF U),-7;ڈcUZrJ#+{gJASvB nU C ^F Ƭ[\U@JHeR.Qq!Sil8i#,{qjHPG1x8Ն._rH=OQ=aP[?*so< = !h`r-1@I9b{sy!D&,yCRaSmgM P`!MJ/!iL(|-Q u@Md#&@HP(L@Z ~N}}0/ށy9#՗t CDH@2OAs(C[*DI˴Iht0!hEBgYaY&ɔmhqMzQ`o?6I 1Eބ |"и:A09,./' ZZ!6PXQZ+]\" %Edp[Z70J\VVEzH( /,ܬBzRgV%W,qSBg㎵ܧ2#GTAؽmL`A(&"ufc2pBVjGa_UM$cN}XۣB?aecbW]c*!XD Nw 0/˽a5Hqy2<yw:BaB|Q亣H@4%qܝL'7xi@0#Ƨ`oQXVx&24I.4xBQ@*Did3LЈ3)XA6;n< %{;K3ݺ{ȅ>([ V i3L|fsk|:9ж&ul@r"ֱcCmS 2FZ Z(ta&y&;C6iǐSP <%[V5̘w|ޖ\,3Ca̭A <.Rd elƌWb_L-KG PvP#?`^ Pt-w J ,DyhYB)NTyrO-x1` $N +O\y1NcJ kHJj>g{%Jܱ5B|qGݳ1}y0P h0'oz@^i  )+ ?{V$۾{o{QF_2~#Q0` Q&Gat$ !LB&lTw!W)3ZE}axķ2CNBz PR@gPK2b-4kP<*v/BV7YZt#6CŃ EDYzS%"ltgg-u#;%Fd#%&'+J  % ; pGGG%t|@-хP%V'Lb  3((v{ Ra/)#kJ؉X&%<~ex( 7 U)u&L'x}`.-5 S+3PIJ_r3#dD yp9Ѐ\¥*`OO0aGS5I$+vHwh/[=8@b."40TS,1pTY$ ) T1ڔSC=Mh+M5*%)B#Q+Y6y8:<)5=R\b?B %q ƔLi>إF[Ã<őU)/ %%VjY#y# 6&!E'vYn@:*#A@3B>08+tQp 5 SwI m)6gS 1HpP_y%Q!)'7© ȩ'E F nyӱ?ʓ*0+-d:Hd0J'J/w?z0 G?pZg#+qF71p0Ɠ60sS .Mv&g'vq4q`]v$>4TqRD%(0MfCn 1&b&! byڡAs\Sn 7[*^1979i\rd2U+$\>#.`ۘOPQ> SXp XåG1)~%)2bAjp0^ g! "aH+e620U!YLqX8ק#<{A\∮SJJ9 aE 0BikP:)E65@ 'bjƲ8Z7C&e::]c\E c@`"]͔/n,J2vJa:ce` y50 $oJC# t#9lw!౹@mCD#l o”X(B.$OL99itdT Zk/Q7TaL\~nGyPjËAk t(o)P7ߊ7u̖C%7"#W%=L@pZb`l"pvG6 ,6C7XrKcte_1UM誯jCFo1(1h%f[  F7w J3GfpGE$,I@KBOvOjt{rPGg`yai<= ]jaz0b&ENs"|JW|Z{ b8=(r lк[qE=W5AEg:*@wz 1}5V=qkڣE{u{@i0_0ŒQtٶd|q.6tKA \o-|It{H~72MT`J֎4\v3!b2zvt:9JZK )mIMLWB[ =*Vb4Tpi1?G%@Ew6nPz7NҺHJH"A YD0ETz{CӰd%J""A0Hx/BEa<>m ëܺ$3 %BoB;W%HPֳe7! 3&tJq\|08( 45ryW zt\"&Q&(77 wGUU%*#mIpټ 0jBX*!H+SAn pR(C4qK qX"@+pl0_kAٚ݌L~o%y&B%rR֏y d'%$-֌hh~HÂd8r9'N;%厰5V+k% XhغR"v 3@Ò&&(5iމg=Ɨ[B#TM.`fwF}$,f Ќ܅rN3Dt(lk_My]>ԁb< e@Nr] CMH5ϴ;6$i Ӻhϴv_v"_1EO?ȯ( 1 aO_5=dR 0Z X1a7'FA1ع= Sd/dՎSQ&4! `*%iU$P("ƃ.be#  TqBT ,4"Q^)]e"  SMr.r 8% 3 =5TQ 򶧒@  @X<~R@ P:RbDVB((Ƀs#.ȟFrm M0Pp1QqQ 1 2ё 0r ɡ/Ra3 a3H)27WұsWIRXy9htjΨ`<\ջ#|>^~;!GIF SmartSaver Ver1.1a;ossp-eperl-ePerl_2_2_15/eperl_main.c000066400000000000000000001033561470477324200174640ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" #include "eperl_perl5.h" #include "eperl_security.h" #include #include #ifdef HAVE_PWD_H #include #endif #ifdef HAVE_GRP_H #include #endif /* * Display an error message and a logfile content as a HTML page */ void PrintError(enum runtime_mode mode, const char *scripturl, const char *scriptfile, char **errstr, size_t *errstrN, const char *str, ...) { char *ca; va_list ap; va_start(ap, str); if (vasprintf(&ca, str, ap) == -1) ca = NULL; va_end(ap); IO_restore_stdout(); IO_restore_stderr(); if (errstr) ePerl_SubstErrorLog(errstr, errstrN, scriptfile, scripturl); if (mode == MODE_CGI || mode == MODE_NPHCGI) { const char *script_name = getenv("SCRIPT_NAME") ?: "UNKNOWN_IMG_DIR"; if (mode == MODE_NPHCGI) HTTP_PrintResponseHeaders(""); printf("Content-Type: text/html\r\n" "\r\n" "\n" "ePerl: ERROR: %1$s\n" "\n" "\"Powered\n" "\n" "\n" "\n" "\n" "\n" "\n" "\n" "
\"Embedded
Version %3$s
\n" "

\n" "\n" "\n" "\n" "
" "ERROR:" "
\n" "

%1$s

\n" "
\n", ca, script_name, EPERL_VERSION_SHORT); if (errstr && *errstrN) { puts("

" "\n" "\n" "\n" "
" "Contents of STDERR channel:" "
\n" "
");
            fwrite(*errstr, 1, *errstrN, stdout);
            puts("
" "
"); } puts("\n" ""); fflush(stdout); } else { fprintf(stderr, "ePerl:Error: %s\n", ca); if (errstr && *errstrN) { fprintf(stderr, "\n" "---- Contents of STDERR channel: ---------\n"); fwrite(*errstr, 1, *errstrN, stderr); if ((*errstr)[strlen(*errstr) - 1] != '\n') fprintf(stderr, "\n"); fprintf(stderr, "------------------------------------------\n"); } fflush(stderr); } free(ca); } static void give_version(void) { fprintf(stdout, "This is ePerl, Version %s (%s)\n" "\n" "Copyright (c) 1996-2000 Ralf S. Engelschall \n" "\n" "This program is distributed in the hope that it will be useful,\n" "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either\n" "the Artistic License or the GNU General Public License for more details.\n", EPERL_VERSION_SHORT, EPERL_VERSION_DATE); } static void give_version_extended(void) { give_version(); fprintf(stdout, "\n" "Characteristics of this binary:\n" " Perl Version : %s (%s)\n" " Perl Library : %s/CORE/libperl.a\n" " Perl DynaLoader : %s\n" " System Libs : %s\n", AC_perl_vers, AC_perl_prog, AC_perl_archlib, AC_perl_dla, AC_perl_libs); } static void give_img(enum runtime_mode mode, const uint8_t *data, size_t len, const char *type) { if (mode == MODE_NPHCGI) HTTP_PrintResponseHeaders(""); printf("Content-Type: image/%s\r\n" "\r\n", type); fwrite(data, 1, len, stdout); } static void give_usage(const char *self) { fprintf(stderr, "Usage: %s [options] [scriptfile]\n" "\n" "Input Options:\n" " -d, --define=NAME=VALUE define global Perl variable ($main::name)\n" " -D, --setenv=NAME=VALUE define environment variable ($ENV{'name'})\n" " -I, --includedir=PATH add @INC/#include directory\n" " -B, --block-begin=STR set begin block delimiter\n" " -E, --block-end=STR set end block delimiter\n" " -n, --nocase force block delimiters to be case insensitive\n" " -k, --keepcwd force keeping of current working directory\n" " -P, --preprocess enable ePerl Preprocessor\n" " -C, --convert-entity enable HTML entity conversion for ePerl blocks\n" " -L, --line-continue enable line continuation via backslashes\n" "\n" "Output Options:\n" " -T, --tainting enable Perl Tainting\n" " -w, --warnings enable Perl Warnings\n" " -x, --debug enable ePerl debugging output on console\n" " -m, --mode=STR force runtime mode to FILTER, CGI or NPH-CGI\n" " -o, --outputfile=PATH force the output to be send to this file (default=stdout)\n" " -c, --check run syntax check only and exit (no execution)\n" "\n" "Giving Feedback:\n" " -r, --readme display ePerl README file\n" " -l, --license display ePerl license files (COPYING and ARTISTIC)\n" " -v, --version display ePerl VERSION id\n" " -V, --ingredients display ePerl VERSION id & compilation parameters\n" " -h, --help display ePerl usage list (this one)\n", self); } static const char **RememberedINC; static size_t RememberedINCLen; static void RememberINC(const char *str) { RememberedINC = reallocarray(RememberedINC, RememberedINCLen + 1, sizeof(*RememberedINC)); RememberedINC[RememberedINCLen++] = str; } static void mysighandler(int rc); static void myinit(void) { struct sigaction sa = {.sa_handler = mysighandler}; sigfillset(&sa.sa_mask); sigaction(SIGINT, &sa, NULL); sigaction(SIGTERM, &sa, NULL); atexit(remove_mytmpfiles); } static void mysighandler(int rc) { (void) rc; IO_restore_stderr(); fputs("ePerl: **INTERRUPT**\n", stderr); exit(EX_FAIL); } static const struct option options[] = { { "define", required_argument, NULL, 'd' }, { "setenv", required_argument, NULL, 'D' }, { "includedir", required_argument, NULL, 'I' }, { "block-begin", required_argument, NULL, 'B' }, { "block-end", required_argument, NULL, 'E' }, { "nocase", no_argument, NULL, 'n' }, { "keepcwd", no_argument, NULL, 'k' }, { "preprocess", no_argument, NULL, 'P' }, { "convert-entity", no_argument, NULL, 'C' }, { "line-continue", no_argument, NULL, 'L' }, { "tainting", no_argument, NULL, 'T' }, { "warnings", no_argument, NULL, 'w' }, { "debug", no_argument, NULL, 'x' }, { "mode", required_argument, NULL, 'm' }, { "outputfile", required_argument, NULL, 'o' }, { "check", no_argument, NULL, 'c' }, { "readme", no_argument, NULL, 'r' }, { "license", no_argument, NULL, 'l' }, { "version", no_argument, NULL, 'v' }, { "ingredients", no_argument, NULL, 'V' }, { "help", no_argument, NULL, 'h' }, {0}, }; /* * main procedure */ int main(int argc, char **argv) { int rc; FILE *fp; char *cpBufScript = NULL; char *cpBufSprinkled2Plain = NULL; char *progname; size_t nBuf; const char *source = NULL; char *cp; struct stat st; struct passwd *pw; struct passwd *pw2; struct group *gr; int uid = 0, gid = 0; bool keepcwd = false; int c; char *cpScript = NULL; bool allow; int n, k; char *outputfile = NULL; int cwd = -1; bool fCheck = false; bool fTaint = false; bool fWarn = false; bool fPP = false; bool fDebug = false; bool fOkSwitch; enum runtime_mode mode = MODE_UNKNOWN; const char *ePerl_begin_delimiter = NULL; const char *ePerl_end_delimiter = NULL; bool ePerl_case_sensitive_delimiters = true; bool ePerl_convert_entities = false; /* first step: our process initialisation */ myinit(); /* second step: canonicalize program name */ progname = argv[0]; if ((cp = strrchr(progname, '/')) != NULL) { progname = cp+1; } /* parse the option arguments */ while ((c = getopt_long(argc, argv, "d:D:I:B:E:nkPCLTwxm:o:crlvVh", options, NULL)) != -1) switch (c) { case 'd': Perl5_RememberScalar(optarg); break; case 'D': putenv(optarg); break; case 'I': RememberINC(optarg); break; case 'B': ePerl_begin_delimiter = optarg; break; case 'E': ePerl_end_delimiter = optarg; break; case 'n': ePerl_case_sensitive_delimiters = false; break; case 'k': keepcwd = true; break; case 'P': fPP = true; break; case 'C': ePerl_convert_entities = true; break; case 'L': ePerl_line_continuation = true; break; case 'T': fTaint = true; break; case 'w': fWarn = true; break; case 'x': fDebug = true; break; case 'm': if (strcasecmp(optarg, "f") == 0 || strcasecmp(optarg, "filter") == 0 ) { mode = MODE_FILTER; } else if (strcasecmp(optarg, "c") == 0 || strcasecmp(optarg, "cgi") == 0 ) { mode = MODE_CGI; } else if (strcasecmp(optarg, "n") == 0 || strcasecmp(optarg, "nph") == 0 || strcasecmp(optarg, "nphcgi") == 0 || strcasecmp(optarg, "nph-cgi") == 0 ) { mode = MODE_NPHCGI; } else { PrintError(mode, "", NULL, NULL, NULL, "Unknown runtime mode %s", optarg); return EX_USAGE; } break; case 'o': outputfile = optarg; break; case 'c': fCheck = true; break; case 'r': (void) fwrite(ePerl_README, 1, ePerl_README_size, stdout); return EX_OK; case 'l': (void) fwrite(ePerl_LICENSE, 1, ePerl_LICENSE_size, stdout); return EX_OK; case 'v': give_version(); return EX_OK; case 'V': give_version_extended(); return EX_OK; case 'h': give_usage(progname); return EX_OK; case '?': fprintf(stderr, "Try %s --help for more information.\n", progname); return EX_USAGE; } /* * determine source filename and runtime mode */ const char *cpCGIgi = getenv("GATEWAY_INTERFACE") ?: ""; const char *cpCGIpt = getenv("PATH_TRANSLATED") ?: ""; const char *cpCGIqs = getenv("QUERY_STRING") ?: ""; bool fCGIqsEqualChar = strchr(cpCGIqs, '='); /* * Server-Side-Scripting-Language: * * Request: * /url/to/nph-eperl/url/to/script.phtml[?query-string] * Environment: * GATEWAY_INTERFACE=CGI/1.1 * SCRIPT_NAME=/url/to/nph-eperl * SCRIPT_FILENAME=/path/to/nph-eperl * PATH_INFO=/url/to/script.phtml * PATH_TRANSLATED=/path/to/script.phtml * a) QUERY_STRING="" * optind=argc * b) QUERY_STRING=query-string (containing "=" char) * optind=argc * c) QUERY_STRING=query-string (containing NO "=" char) * optind=argc-1 * argv[optind]=query-string */ const char *sssl_standalone; if ( cpCGIgi[0] != '\0' && cpCGIpt[0] != '\0' && ( ( optind == argc && ( cpCGIqs[0] == '\0' || fCGIqsEqualChar ) ) || ( optind == argc-1 && !fCGIqsEqualChar && !strcmp(argv[optind], cpCGIqs) ) ) ) { if (strncasecmp(cpCGIgi, "CGI/1", 5) != 0) { fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n"); return EX_IOERR; } /* CGI/1.1 or NPH-CGI/1.1 script, source in PATH_TRANSLATED. */ source = cpCGIpt; sssl_standalone = "SSSL"; purecgi_nph_and_proctitle: /* determine whether pure CGI or NPH-CGI mode */ if (mode == MODE_UNKNOWN) { mode = MODE_CGI; if ((cp = getenv("SCRIPT_FILENAME")) != NULL) { char *cp2 = cp; if ((cp = strrchr(cp2, '/')) != NULL) ++cp; else cp = cp2; if (!strncasecmp(cp, "nph-", 4)) mode = MODE_NPHCGI; } } #if HAVE_SETPROCTITLE /* set the command line for ps output */ setproctitle("%s %s [%sCGI/%s]", argv[0], source, mode == MODE_NPHCGI ? "NPH-" : "", sssl_standalone); #else (void)sssl_standalone; #endif } /* * Stand-Alone inside Webserver environment: * * Request: * /url/to/script.cgi[/path-info][?query-string] * [script.cgi has shebang #!/path/to/eperl] * Environment: * GATEWAY_INTERFACE=CGI/1.1 * SCRIPT_NAME=/url/to/script.cgi * SCRIPT_FILENAME=/path/to/script.cgi * PATH_INFO=/path-info * PATH_TRANSLATED=/path/to/docroot/path-info * a) QUERY_STRING="" * optind=argc-1 * argv[optind]=/path/to/script.cgi * b) QUERY_STRING=query-string (containing "=" char) * optind=argc-1 * argv[optind]=/path/to/script.cgi * c) QUERY_STRING=query-string (containing NO "=" char) * optind=argc-2 * argv[optind]=/path/to/script.cgi * argv[optind+1]=query-string */ else if ( cpCGIgi[0] != '\0' && ( ( optind == argc-1 && ( cpCGIqs[0] == '\0' || fCGIqsEqualChar ) ) || ( optind == argc-2 && !fCGIqsEqualChar && !strcmp(argv[optind+1], cpCGIqs)) ) ) { if (strncasecmp(cpCGIgi, "CGI/1", 5) != 0) { fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n"); return EX_IOERR; } /* CGI/1.1 or NPH-CGI/1.1 script, source in ARGV */ source = argv[optind]; sssl_standalone = "stand-alone"; goto purecgi_nph_and_proctitle; } /* * Stand-Alone outside Webserver environment: * * Request: * eperl script * Environment: * GATEWAY_INTERFACE="" * SCRIPT_NAME="" * SCRIPT_FILENAME="" * PATH_INFO="" * PATH_TRANSLATED="" * QUERY_STRING="" * optind=argc-1 * argv[optind]=script */ else if ( cpCGIgi[0] == '\0' && cpCGIpt[0] == '\0' && cpCGIqs[0] == '\0' && optind == argc-1 ) { /* stand-alone filter, source as argument: either manually on the console or via shebang */ source = argv[optind]; mode = (mode == MODE_UNKNOWN ? MODE_FILTER : mode); /* provide flexibility by recognizing "-" for stdin */ if (!strcmp(source, "-")) { /* store stdin to tmpfile */ struct tmpfile tmp = mytmpfile(tmpfile_stdin); if (tmp.fd == -1) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open tmpfile for writing"); return EX_IOERR; } source = tmp.filename; if (!(fp = fdopen(tmp.fd, "w")) || !ePerl_CopyFILE(stdin, fp) || fclose(fp)) { PrintError(mode, source, NULL, NULL, NULL, "Cannot copy stdin: %s", strerror(errno)); return EX_IOERR; } /* stdin script implies keeping of cwd */ keepcwd = true; } } /* * Any other calling environment is an error... */ else { fprintf(stderr, "ePerl:Error: Missing required file to process\n" "ePerl:Error: Use either a filename, '-' for STDIN or PATH_TRANSLATED.\n" "Try %s --help for more information.\n", progname); return EX_USAGE; } /* set default delimiters */ if (ePerl_begin_delimiter == NULL) ePerl_begin_delimiter = (mode == MODE_FILTER) ? "<:" : "" : "!>"; /* the built-in GIF images */ if ((mode == MODE_CGI || mode == MODE_NPHCGI) && (cp = getenv("PATH_INFO")) != NULL) { if (!strcmp(cp, "/logo.gif")) { give_img(mode, ePerl_LOGO, ePerl_LOGO_size, "gif"); return 0; } else if (!strcmp(cp, "/powered.gif")) { give_img(mode, ePerl_POWERED, ePerl_POWERED_size, "png"); return 0; } } /* CGI modes imply - Preprocessor usage - HTML entity conversions - adding of DOCUMENT_ROOT to include paths */ if (mode == MODE_CGI || mode == MODE_NPHCGI) { fPP = true; ePerl_convert_entities = true; if ((cp = getenv("DOCUMENT_ROOT")) != NULL) RememberINC(cp); } /* check for existing source file */ if ((stat(source, &st)) != 0) { PrintError(mode, source, NULL, NULL, NULL, "%s does not exist", source); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } /* * Security Checks for the CGI modes */ if (mode == MODE_CGI || mode == MODE_NPHCGI) { /* * == General Security == */ /* general security check: allowed file extension */ if (CGI_NEEDS_ALLOWED_FILE_EXT) { allow = false; n = strlen(source); for (size_t i = 0; i < sizeof(allowed_file_ext) / sizeof(*allowed_file_ext); ++i) { k = strlen(allowed_file_ext[i]); if (!strcmp(source+n-k, allowed_file_ext[i])) allow = true; } if (!allow) { PrintError(mode, source, NULL, NULL, NULL, "File %s is not allowed to be interpreted by ePerl (wrong extension!)", source); return EX_OK; } } /* * == Perl Security == */ if (CGI_MODES_FORCE_TAINTING) fTaint = true; if (CGI_MODES_FORCE_WARNINGS) fWarn = true; /* * == UID/GID switching == */ /* we can only do a switching if we have euid == 0 (root) */ if (geteuid() == 0) { fOkSwitch = true; /* get our real user id (= caller uid) */ uid = getuid(); /* security check: valid caller uid */ pw = getpwuid(uid); if (SETUID_NEEDS_VALID_CALLER_UID && pw == NULL) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid UID %d of caller", uid); return EX_OK; } else fOkSwitch = false; } else { /* security check: allowed caller uid */ if (SETUID_NEEDS_ALLOWED_CALLER_UID) { allow = false; for (size_t i = 0; i < sizeof(allowed_caller_uid) / sizeof(*allowed_caller_uid); ++i) { if (isdigit(allowed_caller_uid[i][0])) pw2 = getpwuid(atoi(allowed_caller_uid[i])); else pw2 = getpwnam(allowed_caller_uid[i]); if (pw2 && !strcmp(pw->pw_name, pw2->pw_name)) { allow = true; break; } } if (!allow) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "UID %d of caller not allowed", uid); return EX_OK; } else fOkSwitch = false; } } } /* security check: valid owner UID */ pw = getpwuid(st.st_uid); if (SETUID_NEEDS_VALID_OWNER_UID && pw == NULL) if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid UID %d of owner", st.st_uid); return EX_OK; } else fOkSwitch = false; else uid = pw->pw_uid; /* security check: valid owner GID */ gr = getgrgid(st.st_gid); if (SETUID_NEEDS_VALID_OWNER_GID && gr == NULL) if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid GID %d of owner", st.st_gid); return EX_OK; } else fOkSwitch = false; else gid = gr->gr_gid; /* security check: file has to stay below owner homedir */ if (fOkSwitch && SETUID_NEEDS_BELOW_OWNER_HOME) { /* preserve current working directory */ cwd = cwd != -1 ? cwd : open(".", O_PATH | O_CLOEXEC); /* determine physical homedir of owner */ pw = getpwuid(st.st_uid); if (chdir(pw->pw_dir) == -1) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid homedir %s of file owner", pw->pw_dir); return EX_OK; } else fOkSwitch = false; } else { char *dir_home = getcwd(NULL, 0); /* determine physical dir of file */ if ((cp = strrchr(source, '/')) == NULL) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid script %s: no absolute path", source); return EX_OK; } else fOkSwitch = false; } else { *cp = '\0'; int ch = chdir(source); *cp = '/'; if (ch == -1) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid script %s: cannot chdir to its location", source); return EX_OK; } else fOkSwitch = false; } else { char *dir_script = getcwd(NULL, 0); /* dir_home has to be a prefix of dir_script */ if (strncmp(dir_script, dir_home, strlen(dir_home)) < 0) { if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) { PrintError(mode, source, NULL, NULL, NULL, "Invalid script %s: does not stay below homedir of owner", source); return EX_OK; } else fOkSwitch = false; } free(dir_script); } } free(dir_home); } /* restore original cwd */ fchdir(cwd); } if (fOkSwitch && uid != 0 && gid != 0) { /* switch to new uid/gid */ if (((setgid(gid)) != 0) || (initgroups(pw->pw_name,gid) != 0)) { PrintError(mode, source, NULL, NULL, NULL, "Unable to set GID %d: setgid/initgroups failed", gid); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } if ((setuid(uid)) != 0) { PrintError(mode, source, NULL, NULL, NULL, "Unable to set UID %d: setuid failed", uid); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } } } } /* Security! Eliminate effective root permissions if we are running setuid */ if (geteuid() == 0) { setegid(getgid()); seteuid(getuid()); } /* read source file into internal buffer */ if (!ePerl_ReadSourceFile(source, &cpBufScript, &nBuf)) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open source file %s for reading\n%s", source, ePerl_ErrorString); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } /* strip shebang prefix */ cpScript = cpBufScript; if (strncmp(cpScript, "#!", 2) == 0) { char *line = memchr(cpBufScript, '\n', nBuf); if (!line) cpScript = ""; else cpScript = line + 1; } /* now set the additional env vars */ { char *realsource = realpath(source, NULL), *fellbacksource = realsource ?: (char *)source, *cpPath; char *bn = basename(fellbacksource); putenvf("SCRIPT_SRC_PATH=%s", fellbacksource); putenvf("SCRIPT_SRC_PATH_FILE=%s", bn); putenvf("SCRIPT_SRC_PATH_DIR=%.*s", (int)(bn - fellbacksource) ?: 1, fellbacksource); if ((cpPath = getenv("PATH_INFO")) != NULL) { const char *cpHost = getenv("SERVER_NAME") ?: "localhost"; const char *cpPort = getenv("SERVER_PORT"); if (cpPort && !strcmp(cpPort, "80")) cpPort = NULL; char *fullurl; int fullurllen = asprintf(&fullurl, "http://%s%.*s%s%s", cpHost, !!cpPort, ":", cpPort ?: "", cpPath); bn = fullurl[fullurllen - 1] == '/' ? fullurl + fullurllen : basename(fullurl); putenvf("SCRIPT_SRC_URL=%s", fullurl); putenvf("SCRIPT_SRC_URL_FILE=%s", bn); putenvf("SCRIPT_SRC_URL_DIR=%.*s", (int)(bn - fullurl) ?: 1, fullurl); free(fullurl); } else { putenvf("SCRIPT_SRC_URL=file://%s", fellbacksource); putenvf("SCRIPT_SRC_URL_FILE=%s", bn); putenvf("SCRIPT_SRC_URL_DIR=file://%.*s", (int)(bn - fellbacksource) ?: 1, fellbacksource); } free(realsource); } putenvf("SCRIPT_SRC_SIZE=%zu", nBuf); stat(source, &st); struct tm *tm = localtime(&st.st_mtime); putenvf("SCRIPT_SRC_MODIFIED=%lld", (long long)st.st_mtime); putenvf("SCRIPT_SRC_MODIFIED_CTIME=%.24s", ctime(&st.st_mtime)); putenvf("SCRIPT_SRC_MODIFIED_ISOTIME=%02d-%02d-%04d %02d:%02d", tm->tm_mday, tm->tm_mon+1, tm->tm_year+1900, tm->tm_hour, tm->tm_min); if ((pw = getpwuid(st.st_uid)) != NULL) putenvf("SCRIPT_SRC_OWNER=%s", pw->pw_name); else putenvf("SCRIPT_SRC_OWNER=unknown-uid-%d", st.st_uid); putenvf("VERSION_INTERPRETER=ePerl/%s", EPERL_VERSION_SHORT); putenvf("VERSION_LANGUAGE=Perl/%s", AC_perl_vers); char *sourcedir = dirname(strdup(source)); /* optionally run the ePerl preprocessor */ if (fPP) { /* switch to directory where script stays */ cwd = cwd != -1 ? cwd : open(".", O_PATH | O_CLOEXEC); if (strcmp(sourcedir, ".")) chdir(sourcedir); /* run the preprocessor */ char *cpBufPP = ePerl_PP(cpScript, RememberedINC, RememberedINCLen, ePerl_begin_delimiter, ePerl_end_delimiter, ePerl_case_sensitive_delimiters); if (cpBufPP == NULL) { PrintError(mode, source, NULL, NULL, NULL, "Preprocessing failed for %s: %s", source, ePerl_ErrorString); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } cpScript = cpBufPP; /* switch to previous dir */ fchdir(cwd); free(cpBufScript); cpBufScript = cpBufPP; } /* convert sprinkled source to valid Perl code */ if ((cpBufSprinkled2Plain = ePerl_Sprinkled2Plain(cpScript, ePerl_begin_delimiter, ePerl_end_delimiter, ePerl_case_sensitive_delimiters, ePerl_convert_entities)) == NULL) { PrintError(mode, source, NULL, NULL, NULL, "Cannot convert sprinkled code file %s to pure HTML: %s", source, ePerl_ErrorString); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } cpScript = cpBufSprinkled2Plain; free(cpBufScript); /* write buffer to temporary script file */ struct tmpfile perlscript = mytmpfile(tmpfile_script); if (perlscript.fd == -1 || (fp = fdopen(perlscript.fd, "w")) == NULL || fputs(cpScript, fp) == EOF || fclose(fp)) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open Perl script file %s for writing", perlscript.filename); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } /* in Debug mode output the script to the console */ if (fDebug) { if ((fp = fopen("/dev/tty", "w")) == NULL) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open /dev/tty for debugging message"); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } fputs("----internally created Perl script-----------------------------------\n", fp); fputs(cpScript, fp); if (cpScript[strlen(cpScript) - 1] != '\n') fputc('\n', fp); fputs("----internally created Perl script-----------------------------------\n", fp); fclose(fp); } free(cpBufSprinkled2Plain); /* create command line... */ int myargc = 0; char **myargv = reallocarray(NULL, 1 + fTaint + fWarn + 2 * RememberedINCLen + 1 + 1, sizeof(*myargv)); /* - program name and possible -T -w options */ myargv[myargc++] = progname; if (fTaint) myargv[myargc++] = "-T"; if (fWarn) myargv[myargc++] = "-w"; /* - previously remembered Perl 5 INC entries (option -I) */ for (size_t i = 0; i != RememberedINCLen; ++i) { myargv[myargc++] = "-I"; myargv[myargc++] = (char *)RememberedINC[i]; } /* - and the script itself */ myargv[myargc++] = perlscript.filename; myargv[myargc] = NULL; char *cpOut; size_t nOut; rc = Perl5_Run(myargc, myargv, mode, fCheck, keepcwd, &cwd, sourcedir, source, perlscript.filename, &cpOut, &nOut); /* Return code: * 0: ok * -1: fCheck && mode == MODE_FILTER and * no error detected by perl_parse() * otherwise: error detected by perl_parse() or perl_run() * Error message has already been delivered bu Perl5_Run. */ if (rc == -1) { fprintf(stderr, "%s syntax OK\n", source); return EX_OK; } else if (rc != 0) return mode == MODE_FILTER ? EX_FAIL : EX_OK; if (mode == MODE_NPHCGI || mode == MODE_CGI) { /* if we are running as a NPH-CGI/1.1 script we had to provide the HTTP reponse headers ourself */ if (mode == MODE_NPHCGI) { size_t skip = HTTP_PrintResponseHeaders(cpOut); cpOut += skip; nOut -= skip; } /* if there are no HTTP header lines, we print a basic Content-Type header which should be ok */ if (!HTTP_HeadersExists(cpOut)) { printf("Content-Type: text/html\r\n" "Content-Length: %zu\r\n" "\r\n", nOut); } } /* now we create the output */ if (outputfile != NULL && strcmp(outputfile, "-")) { /* if we remembered current working dir, restore it now */ if (mode == MODE_FILTER && cwd != -1) fchdir(cwd); /* open outputfile */ if (freopen(outputfile, "w", stdout) == NULL) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open output file %s for writing", outputfile); return mode == MODE_FILTER ? EX_IOERR : EX_OK; } } /* and write out the data */ fwrite(cpOut, nOut, 1, stdout); return rc; } ossp-eperl-ePerl_2_2_15/eperl_parse.c000066400000000000000000000355041470477324200176510ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" #include bool ePerl_line_continuation = false; char *ePerl_ErrorString = NULL; /* ** save ePerl error string */ void ePerl_SetError(const char *str, ...) { va_list ap; va_start(ap, str); free(ePerl_ErrorString); if (vasprintf(&ePerl_ErrorString, str, ap) == -1) ePerl_ErrorString = NULL; va_end(ap); } /* ** fwrite for internal buffer WITH character escaping */ static void ePerl_Efwrite(const char *cpI, size_t nBuf, size_t cNum, FILE *output) { nBuf *= cNum; char orig = cpI[nBuf]; ((char *)cpI)[nBuf] = '\0'; while (nBuf) { size_t literal = strcspn(cpI, "\"@$\\\t\n"); fwrite(cpI, 1, literal, output); cpI += literal, nBuf -= literal; while (nBuf) switch (*cpI) { case '"': case '@': case '$': case '\\': fputc('\\', output); fputc(*cpI, output); ++cpI, --nBuf; break; case '\t': fputs("\\t", output); ++cpI, --nBuf; break; case '\n': fputs("\\n", output); ++cpI, --nBuf; break; default: goto break2; } break2:; } fwrite(cpI, 1, nBuf, output); ((char *)cpI)[nBuf] = orig; } /* ** fwrite for internal buffer WITH HTML entity conversion to CP-1252 */ #define HTML2CHAR_MIN 2 #define HTML2CHAR_MAX 6 struct html2char { char h[HTML2CHAR_MAX]; char c; }; static const struct html2char html2char_2[] = { { "gt", '>' }, /* Greater than */ { "lt", '<' }, /* Less than */ { "um", '\xA8' }, /* Diæresis / Umlaut */ }; static const struct html2char html2char_3[] = { { "ETH", '\xD0' }, /* Capital Eth, Icelandic */ { "amp", '&' }, /* Ampersand */ { "deg", '\xB0' }, /* Degree sign */ { "die", '\xA8' }, /* Diæresis / Umlaut */ { "eth", '\xF0' }, /* Small eth, Icelandic */ { "not", '\xAC' }, /* Not sign */ { "reg", '\xAE' }, /* Registered trademark */ { "shy", '\xAD' }, /* Soft hyphen */ { "yen", '\xA5' }, /* Yen sign */ }; static const struct html2char html2char_4[] = { { "Auml", '\xC4' }, /* Capital A, diæresis / umlaut */ { "Euml", '\xCB' }, /* Capital E, diæresis / umlaut */ { "Iuml", '\xCF' }, /* Capital I, diæresis / umlaut */ { "Ouml", '\xD6' }, /* Capital O, diæresis / umlaut */ { "Uuml", '\xDC' }, /* Capital U, diæresis / umlaut */ { "auml", '\xE4' }, /* Small a, diæresis / umlaut */ { "cent", '\xA2' }, /* Cent sign */ { "copy", '\xA9' }, /* Copyright */ { "euml", '\xEB' }, /* Small e, diæresis / umlaut */ { "iuml", '\xEF' }, /* Small i, diæresis / umlaut */ { "macr", '\xAF' }, /* Macron accent */ { "nbsp", '\x20' }, /* Non-breaking Space */ { "ordf", '\xAA' }, /* Feminine ordinal */ { "ordm", '\xBA' }, /* Masculine ordinal */ { "ouml", '\xF6' }, /* Small o, diæresis / umlaut */ { "para", '\xB6' }, /* Paragraph sign */ { "quot", '"' }, /* Quotation mark */ { "sect", '\xA7' }, /* Section sign */ { "sup1", '\xB9' }, /* Superscript one */ { "sup2", '\xB2' }, /* Superscript two */ { "sup3", '\xB3' }, /* Superscript three */ { "uuml", '\xFC' }, /* Small u, diæresis / umlaut */ { "yuml", '\xFF' }, /* Small y, diæresis / umlaut */ }; static const struct html2char html2char_5[] = { { "AElig", '\xC6' }, /* Capital AE ligature */ { "Acirc", '\xC2' }, /* Capital A, circumflex */ { "Aring", '\xC5' }, /* Capital A, ring */ { "Ecirc", '\xCA' }, /* Capital E, circumflex */ { "Icirc", '\xCE' }, /* Capital I, circumflex */ { "Ocirc", '\xD4' }, /* Capital O, circumflex */ { "THORN", '\xDE' }, /* Capital Thorn, Icelandic */ { "Ucirc", '\xDB' }, /* Capital U, circumflex */ { "acirc", '\xE2' }, /* Small a, circumflex */ { "acute", '\xB4' }, /* Acute accent */ { "aelig", '\xE6' }, /* Small ae ligature */ { "aring", '\xE5' }, /* Small a, ring */ { "cedil", '\xB8' }, /* Cedilla */ { "ecirc", '\xEA' }, /* Small e, circumflex */ { "hibar", '\xAF' }, /* Macron accent */ { "icirc", '\xEE' }, /* Small i, circumflex */ { "iexcl", '\xA1' }, /* Inverted exclamation */ { "laquo", '\xAB' }, /* Left angle quote, guillemot left */ { "micro", '\xB5' }, /* Micro sign */ { "ocirc", '\xF4' }, /* Small o, circumflex */ { "pound", '\xA3' }, /* Pound sterling */ { "raquo", '\xBB' }, /* Right angle quote, guillemot right */ { "szlig", '\xDF' }, /* Small sharp s, German sz */ { "thorn", '\xFE' }, /* Small thorn, Icelandic */ { "times", '\xD7' }, /* Multiply sign */ { "ucirc", '\xFB' }, /* Small u, circumflex */ }; static const struct html2char html2char_6[] = { { "Aacute", '\xC1' }, /* Capital A, acute accent */ { "Agrave", '\xC0' }, /* Capital A, grave accent */ { "Atilde", '\xC3' }, /* Capital A, tilde */ { "Ccedil", '\xC7' }, /* Capital C, cedilla */ { "Eacute", '\xC9' }, /* Capital E, acute accent */ { "Egrave", '\xC8' }, /* Capital E, grave accent */ { "Iacute", '\xCD' }, /* Capital I, acute accent */ { "Igrave", '\xCC' }, /* Capital I, grave accent */ { "Ntilde", '\xD1' }, /* Capital N, tilde */ { "Oacute", '\xD3' }, /* Capital O, acute accent */ { "Ograve", '\xD2' }, /* Capital O, grave accent */ { "Oslash", '\xD8' }, /* Capital O, slash */ { "Otilde", '\xD5' }, /* Capital O, tilde */ { "Uacute", '\xDA' }, /* Capital U, acute accent */ { "Ugrave", '\xD9' }, /* Capital U, grave accent */ { "Yacute", '\xDD' }, /* Capital Y, acute accent */ { "aacute", '\xDF' }, /* Small a, acute accent */ { "agrave", '\xE0' }, /* Small a, grave accent */ { "atilde", '\xE3' }, /* Small a, tilde */ { "brkbar", '\xA6' }, /* Broken vertical bar */ { "brvbar", '\xA6' }, /* Broken vertical bar */ { "ccedil", '\xE7' }, /* Small c, cedilla */ { "curren", '\xA4' }, /* General currency sign */ { "divide", '\xF7' }, /* Division sign */ { "eacute", '\xE9' }, /* Small e, acute accent */ { "egrave", '\xE8' }, /* Small e, grave accent */ { "frac12", '\xBD' }, /* Fraction one-half */ { "frac14", '\xBC' }, /* Fraction one-fourth */ { "frac34", '\xBE' }, /* Fraction three-fourths */ { "iacute", '\xED' }, /* Small i, acute accent */ { "igrave", '\xEC' }, /* Small i, grave accent */ { "iquest", '\xBF' }, /* Inverted question mark */ { "middot", '\xB7' }, /* Middle dot */ { "ntilde", '\xF1' }, /* Small n, tilde */ { "oacute", '\xF3' }, /* Small o, acute accent */ { "ograve", '\xF2' }, /* Small o, grave accent */ { "oslash", '\xF8' }, /* Small o, slash */ { "otilde", '\xF5' }, /* Small o, tilde */ { "plusmn", '\xB1' }, /* Plus or minus */ { "uacute", '\xFA' }, /* Small u, acute accent */ { "ugrave", '\xF9' }, /* Small u, grave accent */ { "yacute", '\xFD' }, /* Small y, acute accent */ }; static const struct { const struct html2char *h2c; size_t h2cn; } html2chars[] = { {html2char_2, sizeof(html2char_2) / sizeof(*html2char_2)}, {html2char_3, sizeof(html2char_3) / sizeof(*html2char_3)}, {html2char_4, sizeof(html2char_4) / sizeof(*html2char_4)}, {html2char_5, sizeof(html2char_5) / sizeof(*html2char_5)}, {html2char_6, sizeof(html2char_6) / sizeof(*html2char_6)}, }; static int html2char_cmp(const void *lhs, const void *rhs) { return memcmp(((const struct html2char *)lhs)->h, ((const struct html2char *)rhs)->h, HTML2CHAR_MAX); } static void ePerl_Cfwrite(const char *cpBuf, size_t nBuf, size_t cNum, FILE *output) { nBuf *= cNum; for (char *amp; (amp = memchr(cpBuf, '&', nBuf)); ) { fwrite(cpBuf, 1, amp - cpBuf, output); nBuf -= amp - cpBuf; cpBuf = amp; char *semi = memchr(cpBuf, ';', nBuf); if (!semi) break; ++semi; nBuf -= semi - cpBuf; cpBuf = semi; size_t namelen = semi - amp - 2; if (namelen < HTML2CHAR_MIN || namelen > HTML2CHAR_MAX) { nomatch: fwrite(amp, 1, semi - amp, output); continue; } struct html2char key = {0}; memcpy(key.h, amp + 1, namelen); struct html2char *ent = bsearch(&key, html2chars[namelen - HTML2CHAR_MIN].h2c, html2chars[namelen - HTML2CHAR_MIN].h2cn, sizeof(struct html2char), html2char_cmp); if (!ent) goto nomatch; fputc(ent->c, output); } fwrite(cpBuf, 1, nBuf, output); } /* ** memmem() but case-insensitive; basically equivalent to strncasestr() */ void *memcasemem(const void *buf, size_t n, const void *str, size_t len) { for (const char *cp = buf, *cpe = buf + n - len; cp <= cpe; ++cp) if (strncasecmp(cp, str, len) == 0) return (void *)cp; return NULL; } /* ** convert buffer from sprinkled format to plain format */ char *ePerl_Sprinkled2Plain(const char *cpBuf, const char *ePerl_begin_delimiter, const char *ePerl_end_delimiter, bool ePerl_case_sensitive_delimiters, bool ePerl_convert_entities) { char *cpOutBuf = NULL; size_t nOutBuf = 0; const char *cps, *cpe; const char *cps2, *cpe2; size_t ePerl_begin_delimiter_len = strlen(ePerl_begin_delimiter); size_t ePerl_end_delimiter_len = strlen(ePerl_end_delimiter); if (!*cpBuf) { /* make sure we return a buffer which the caller can free() */ return strdup(""); } const char *cpEND = cpBuf+strlen(cpBuf); FILE *output = open_memstream(&cpOutBuf, &nOutBuf); if (!output) { ePerl_SetError("Cannot allocate memstream: %s", strerror(errno)); return NULL; } /* now step through the file and convert it to legal Perl code. This is a bit complicated because we have to make sure that we parse the correct delimiters while the delimiter characters could also occur inside the Perl code! */ cps = cpBuf; while (cps < cpEND) { cpe = (ePerl_case_sensitive_delimiters ? memmem : memcasemem)(cps, cpEND - cps, ePerl_begin_delimiter, ePerl_begin_delimiter_len); if (cpe == NULL) cpe = cpEND; /* first, encapsulate the content from current pos up to the begin of the ePerl block as print statements */ cps2 = cps; /* first, do all complete lines */ while ((cpe2 = memchr(cps2, '\n', cpe-cps2)) != NULL) { if (ePerl_line_continuation && cps < cpe2 && *(cpe2-1) == '\\') { if (cpe2-1-cps2 > 0) { fputs("print \"", output); ePerl_Efwrite(cps2, cpe2-1-cps2, 1, output); fputs("\";", output); } fputc('\n', output); } else { fputs("print \"", output); ePerl_Efwrite(cps2, cpe2-cps2, 1, output); fputs("\\n\";\n", output); } cps2 = cpe2+1; } /* then do the remainder which is not finished by a newline */ if (cpe > cps2) { fputs("print \"", output); ePerl_Efwrite(cps2, cpe-cps2, 1, output); fputs("\";", output); } /* Ok, there is at least one more ePerl block */ if (cpe == cpEND) break; /* just output a leading space to make the -x display more readable. */ if (ftell(output) && (fflush(output), cpOutBuf[nOutBuf - 1] != '\n')) fputc(' ', output); /* skip the start delimiter */ cps = cpe+strlen(ePerl_begin_delimiter); /* recognize the 'print' shortcut with '=', * e.g. <:=$var:> */ if (*cps == '=') { fputs("print ", output); cps++; } /* skip all following whitespaces. Be careful: we could skip newlines too, but then the error output will give wrong line numbers!!! */ while (cps < cpEND) { if (*cps != ' ' && *cps != '\t') break; cps++; } cpe = cps; /* move forward to end of ePerl block. */ cpe = (ePerl_case_sensitive_delimiters ? memmem : memcasemem)(cpe, cpEND-cpe, ePerl_end_delimiter, ePerl_end_delimiter_len); if (cpe == NULL) { ePerl_SetError("Missing end delimiter"); goto CUS; } /* step again backward over whitespaces */ for (cpe2 = cpe; cpe2 > cps && (*(cpe2-1) == ' ' || *(cpe2-1) == '\t' || *(cpe2-1) == '\n'); cpe2--) ; /* pass through the ePerl block without changes! */ if (cpe2 > cps) { if (ePerl_convert_entities) ePerl_Cfwrite(cps, cpe2-cps, 1, output); else fwrite(cps, cpe2-cps, 1, output); /* be smart and automatically add a semicolon if not provided at the end of the ePerl block. But know the continuation indicator "_". */ if ((*(cpe2-1) != ';') && (*(cpe2-1) != '_') ) fputc(';', output); if (*(cpe2-1) == '_') fseek(output, -1, SEEK_CUR); } /* end preserve newlines for correct line numbers */ for ( ; cpe2 <= cpe; cpe2++) if (*cpe2 == '\n') fputc('\n', output); /* output a trailing space to make the -x display more readable when no newlines have finished the block. */ if (ftell(output) && (fflush(output), cpOutBuf[nOutBuf - 1] != '\n')) fputc(' ', output); /* and adjust the current position to the first character after the end delimiter */ cps = cpe+strlen(ePerl_end_delimiter); /* finally just one more feature: when an end delimiter is directly followed by "//" this discards all data up to and including the following newline */ if (cps < cpEND-2 && *cps == '/' && *(cps+1) == '/') { /* skip characters */ cps += 2; for ( ; cps < cpEND && *cps != '\n'; cps++) ; if (cps < cpEND) cps++; /* but preserve the newline in the script */ fputc('\n', output); } } fclose(output); cpOutBuf[nOutBuf] = '\0'; return cpOutBuf; CUS: fclose(output); free(cpOutBuf); return NULL; } ossp-eperl-ePerl_2_2_15/eperl_perl5.c000066400000000000000000000140111470477324200175540ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" #include "eperl_perl5.h" #include #ifdef HAVE_PERL_DYNALOADER extern void boot_DynaLoader _((pTHX_ CV* cv)); /* ** the Perl XS init function for dynamic library loading */ static void Perl5_XSInit(pTHX) { /* do newXS() the available modules */ DO_NEWXS_STATIC_MODULES } #else #define Perl5_XSInit NULL #endif /* HAVE_PERL_DYNALOADER */ /* ** ** sets a Perl scalar variable ** */ static void Perl5_SetScalar(pTHX_ char *pname, char *vname, char *vvalue) { dTHR; ENTER; save_hptr(&PL_curstash); PL_curstash = gv_stashpv(pname, true); sv_setpv(perl_get_sv(vname, true), vvalue); LEAVE; } /* ** remember a Perl scalar variable ** and set it later ** ** (this is needed because we have to ** remember the scalars when parsing ** the command line, but actually setting ** them can only be done later when the ** Perl 5 interpreter is allocated !!) */ static char **Perl5_RememberedScalars; static size_t Perl5_RememberedScalarsLen; void Perl5_RememberScalar(char *str) { Perl5_RememberedScalars = reallocarray(Perl5_RememberedScalars, Perl5_RememberedScalarsLen + 1, sizeof(*Perl5_RememberedScalars)); Perl5_RememberedScalars[Perl5_RememberedScalarsLen++] = str; } static void Perl5_SetRememberedScalars(pTHX) { for (size_t i = 0; i < Perl5_RememberedScalarsLen; ++i) { char *cp = strchr(Perl5_RememberedScalars[i], '='); *cp++ = '\0'; Perl5_SetScalar(aTHX_ "main", Perl5_RememberedScalars[i], cp); } free(Perl5_RememberedScalars); } struct stdfd_thread_state { FILE *memfd; int pipe[2]; }; static void *stdfd_thread(void *arg) { struct stdfd_thread_state *state = arg; FILE *piperd = fdopen(state->pipe[0], "r"); if (piperd) ePerl_CopyFILE(piperd, state->memfd); state->pipe[0] = -1; fclose(piperd); return 0; } static void stdfd_thread_cu(struct stdfd_thread_state *state, pthread_t *thread) { if (state->pipe[1] != -1) { close(state->pipe[1]); state->pipe[1] = -1; } if (*thread) { pthread_join(*thread, NULL); *thread = 0; } if (state->pipe[0] != -1) { close(state->pipe[0]); state->pipe[0] = -1; } if (state->memfd) { fclose(state->memfd); state->memfd = NULL; } } int Perl5_Run(int myargc, char **myargv, enum runtime_mode mode, bool fCheck, bool keepcwd, int *cwd, const char *sourcedir, const char *source, const char *perlscript, char **stdoutBuf, size_t *nstdoutBuf) { int rc; bool rc_checkstderr = false; PerlInterpreter *my_perl = NULL; char *stderrBuf; size_t nstderrBuf; pthread_t stdout_thread = 0, stderr_thread = 0; struct stdfd_thread_state perlstdout = {open_memstream( stdoutBuf, nstdoutBuf), {-1, -1}}; struct stdfd_thread_state perlstderr = {open_memstream(&stderrBuf, &nstderrBuf), {-1, -1}}; if (pipe2(perlstdout.pipe, O_CLOEXEC) || pipe2(perlstderr.pipe, O_CLOEXEC) || ((errno = pthread_create(&stdout_thread, NULL, stdfd_thread, &perlstdout)) && ((stdout_thread = 0), true)) || ((errno = pthread_create(&stderr_thread, NULL, stdfd_thread, &perlstderr)) && ((stderr_thread = 0), true))) { PrintError(mode, source, NULL, NULL, NULL, "Cannot open script I/O: %s", strerror(errno)); CU(mode == MODE_FILTER ? EX_IOERR : EX_OK); } IO_redirect_stdout(perlstdout.pipe[1]); IO_redirect_stderr(perlstderr.pipe[1]); close(perlstdout.pipe[1]); close(perlstderr.pipe[1]); perlstdout.pipe[1] = -1; perlstderr.pipe[1] = -1; /* now allocate the Perl interpreter */ PERL_SYS_INIT3(&myargc, &myargv, &environ); my_perl = perl_alloc(); perl_construct(my_perl); /* now parse the script! NOTICE: At this point, the script gets only _parsed_, not evaluated/executed! */ rc = perl_parse(my_perl, Perl5_XSInit, myargc, myargv, environ); if (rc != 0) { IO_restore_stderr(); stdfd_thread_cu(&perlstderr, &stderr_thread); if (fCheck && mode == MODE_FILTER) { if (nstderrBuf) { ePerl_SubstErrorLog(&stderrBuf, &nstderrBuf, perlscript, source); fwrite(stderrBuf, 1, nstderrBuf, stderr); } CU(EX_FAIL); } else { PrintError(mode, source, perlscript, &stderrBuf, &nstderrBuf, "Perl parsing error (interpreter rc=%d)", rc); CU(mode == MODE_FILTER ? EX_FAIL : EX_OK); } } /* Stop when we are just doing a syntax check */ if (fCheck && mode == MODE_FILTER) CU(-1); // sentinel "ok :), quick exit" /* change to directory of script: this actually is not important to us, but really useful for the ePerl source file programmer!! */ if (!keepcwd) { /* if running as a Unix filter remember the cwd for outputfile */ if (mode == MODE_FILTER) *cwd = *cwd != -1 ? *cwd : open(".", O_PATH | O_CLOEXEC); /* determine dir of source file and switch to it */ if (strcmp(sourcedir, ".")) chdir(sourcedir); } Perl5_SetRememberedScalars(aTHX); // eperl -d rc = perl_run(my_perl); rc_checkstderr = true; CUS: /* Ok, the script got evaluated. Now we can destroy and de-allocate the Perl interpreter */ if (my_perl) { perl_destruct(my_perl); perl_free(my_perl); } IO_restore_stdout(); IO_restore_stderr(); stdfd_thread_cu(&perlstdout, &stdout_thread); stdfd_thread_cu(&perlstderr, &stderr_thread); if (rc_checkstderr) { /* when the Perl interpreter failed or there is data on stderr, we print a error page */ if (rc != 0 || nstderrBuf) { PrintError(mode, source, perlscript, &stderrBuf, &nstderrBuf, "Perl runtime error (interpreter rc=%d)", rc); rc = mode == MODE_FILTER ? EX_FAIL : EX_OK; } } free(stderrBuf); return rc; } ossp-eperl-ePerl_2_2_15/eperl_perl5.h000066400000000000000000000007501470477324200175660ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #ifndef EPERL_PERL5_H #define EPERL_PERL5_H 1 /* first include the standard Perl includes designed for embedding */ #define PERL_NO_GET_CONTEXT /* for efficiency reasons, see perlguts(3) */ #include #include #ifndef aTHX #define aTHX #define aTHX_ #define pTHX void #define pTHX_ #endif #endif /* EPERL_PERL5_H */ ossp-eperl-ePerl_2_2_15/eperl_perl5_sm.pl000066400000000000000000000024601470477324200204510ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1997 Ralf S. Engelschall, All Rights Reserved. # code stolen from Perl 5.004_04's ExtUtils::Embed because # this module is only available in newer Perl versions. use Config; sub static_ext { unless (scalar @Extensions) { @Extensions = sort split /\s+/, $Config{static_ext}; unshift @Extensions, qw(DynaLoader); } return @Extensions; } sub xsi_body { my(@exts) = @_; my($pname,@retval,%seen); my($dl) = canon('DynaLoader'); foreach $_ (@exts){ my($pname) = canon($_); my($mname, $cname, $ccode); ($mname = $pname) =~ s!/!::!g; ($cname = $pname) =~ s!/!__!g; if ($pname eq $dl){ $ccode = "newXS(\"${mname}::boot_${cname}\", boot_${cname}, __FILE__); "; } else { $ccode = "newXS(\"${mname}::bootstrap\", boot_${cname}, __FILE__); "; } push(@retval, $ccode) unless $seen{$ccode}++; } return join '', @retval; } sub canon { my(@ext) = @_; foreach(@ext) { # might be X::Y or lib/auto/X/Y/Y.a next if s!::!/!g; s:^(lib|ext)/(auto/)?::; s:/\w+\.\w+$::; } return @ext; } @mods = (); push(@mods, static_ext()); @mods = grep(!$seen{$_}++, @mods); print xsi_body(@mods); ossp-eperl-ePerl_2_2_15/eperl_powered.png000066400000000000000000000102331470477324200205360ustar00rootroot00000000000000PNG  IHDRxF0ʠ=PLTEWWWiih110zzyGGGiis̘֏ttteezvi1)ZZÁv\qiUҒ SNBB7cY?f]HȉygE<(ȴżYTIסQI5ؿø{{ qme,,D# YYø00PORNNʫts\\eNOQw¾<: wZHvjh@*,%x*jd%wZx<=:vYvfv`XVP,P,c(H@xPtjbKGD pHYs.#.#x?v 4IDATxYm_8%@$IS !!@K(-нMlyho^hc[>NLqAu3`NqA]1L2d=nad.O ] Xց8̰ ـU`2cK>W'ZW eXJr*ր[e+Z $H$o>k!: ,j5;(2a,$XauF7ޒr̐6 -eҺ1;*6#I_f|]֔k%tnlB {_u`dV,̎ߠ3LNĨnhs$\cfPRA[;Z"@SE龀z7b7 H`[ϭRfؘd; { +V65)7>r\t7Eӥ~ JSԁRW,Ҡ+*[7 #B=_u^CWGO!+ɽ>[y웅u |筠" *a{[W~pQ5ͦxA,M ] *G\H Yui8Iz'8AtWU )FnvآIf_2{&H hև)(V?:;N $LOv=ǁa)*u\N]!2.KqkKb3yB0 um[*o+Mj[Ezi; A4 V7j7 AEx9Zov;rFW  `8hԜttLq/p}}s4 In@rjR.QT}b{@Uh$F wNHjhJww?\$ǻҴz:Ou AR3^$phcaLQ29sq < h:$^ڴ+^Ax898Gu>$9< ]x`YnXjϮ d]†xGRw0:A007wF%8Fcn4{j23]v+VQh'Óq2>v&σ߂_yAWaL*ԗVr"_cp~ztl'N$}6B{x<:ot2.6PF^88[Dy4Afw4T'5do($JoB^8VzاMD QE#Iy2 ƶJѩRaqҫf`<%359xܽL/]DVvxM ã4٣Q]L*S: ;^CbM)ːr"Gx@G~}c7bPLƐ"j2f B/b'GLTl&_ʎOx"qz_uxg$ Z] c0c`b)gIp14P/v/8zeC-2jbH["b y,Y탚ܰIcڝip .j%ùpZU*n&\)bPfc&˫=YRqPq>IreΓP hl>Ù -K[6fyn^3"VLB:rU l:߹65ǵ!Wܶ&W~!8S@b~:o<dl:x^｣kg@o4pzKrp`쒯"C =:Y[Rh -we MlBlN[%840ĕ!r` ;oF3jdQ"a5NASu@Nr|9hѨj9ZR-?y2,2"bO*4H+7 i5JLN”KǹP&2\[ӾcȘ*c5$:sU75VCﶅFIz d\o bDq.f %j$OШ1SMiʘ3Q7zu){x*= Dq17OlX]VUP!˄(Q?X.кTx JB 7̓&d) =+:l ؃K9VIb5"9ka@{J9)-t~lv>6\g4D;먅/yŠ*KQi*zF4$ kvt:~4UT)ϳøљIgЭ `a]|717D:vsJ] 89?^xkrܚ6px)Le`IWԷt>ORaex[s*L9Dm6o<890\32a 5fp#!kk"Tp+K4% YW @xZ-t*w؂0(չ2^P&&XՙtmX`ïmK+<&Xؠ˕B}cc:h^ilĭ5^i8pH i/nS܂cJ2GpTQf6B*mYNJd-zTbԥl@rչѺ*1BJio@N 4 /0Aܒ77j3MqJc!g-tpX#6ˊ"Nx,vS)LxGE I9D|.ϮC^ 9]Xkw]%:˥:Ve>ʥ>Sz0;X*57O8k}Ҭ'o~MDFMIENDB`ossp-eperl-ePerl_2_2_15/eperl_pp.c000066400000000000000000000212161470477324200171510ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" enum ppmode { ppmode_file, ppmode_buffer }; struct span { char *str; size_t len; }; /* ** expand #include directives in buffer */ static struct span ePerl_PP_Process(char *cpInput, const char *const *cppINC, size_t cppINCLen, enum ppmode mode, const char *ePerl_begin_delimiter, const char *ePerl_end_delimiter, bool ePerl_case_sensitive_delimiters) { char *cp; char *cpT = NULL; char *cpInBuf = NULL; char *cpBuf; size_t nBuf; if (*cpInput == '\0') return (struct span){strdup(""), 0}; if (mode == ppmode_buffer) { /* treat input as buffer */ cpBuf = cpInput; nBuf = strlen(cpBuf); } else { /* treat input as filename */ FILE *fp; if (strncmp(cpInput, "http://", 7) == 0) { fp = HTTP_openURLasFP(cpInput); } else if (*cpInput == '/') { fp = fopen(cpInput, "r"); } else { fp = fopen(cpInput, "r"); if (fp == NULL) { /* we have to try in all include directories! */ char *full = NULL; for (size_t i = 0; i != cppINCLen; ++i) { free(full); if (asprintf(&full, "%s/%s", cppINC[i], cpInput) == -1) break; if ((fp = fopen(full, "r")) != NULL) break; } free(full); } } if (fp == NULL) { ePerl_SetError("Cannot open source file %s for reading", cpInput); return (struct span){}; } FILE *Buf = open_memstream(&cpBuf, &nBuf); if (!ePerl_CopyFILE(fp, Buf)) { ePerl_SetError("Cannot read from file %s", cpInput); return (struct span){}; } fclose(fp); fclose(Buf); cpInBuf = cpBuf; } char *cpEND = cpBuf+nBuf; char *cps = cpBuf; struct span ret; FILE *OutBuf = open_memstream(&ret.str, &ret.len); while (cps < cpEND) { /* * search for any more directives */ cp = NULL; if (cps == cpBuf || ((cps > cpBuf) && (*(cps-1) == '\n'))) { if ((strncmp(cps, "#include", sizeof("#include") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#sinclude", sizeof("#sinclude") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#if", sizeof("#if") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#elsif", sizeof("#elsif") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#else", sizeof("#else") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#endif", sizeof("#endif") - 1) == 0) && (cp == NULL)) cp = cps; if ((strncmp(cps, "#c", sizeof("#c") - 1) == 0) && (cp == NULL)) cp = cps; } if (((cpT = memmem(cps, cpEND-cps, "\n#include", sizeof("\n#include") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#sinclude", sizeof("\n#sinclude") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#if", sizeof("\n#if") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#elsif", sizeof("\n#elsif") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#else", sizeof("\n#else") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#endif", sizeof("\n#endif") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (((cpT = memmem(cps, cpEND-cps, "\n#c", sizeof("\n#c") - 1)) != NULL) && ((cpT < cp) || (cp == NULL))) cp = cpT+1; if (cp != NULL && (cp == cpBuf || (cp > cpBuf && *(cp-1) == '\n'))) { /* copy data up to directive */ fwrite(cps, 1, cp-cps, OutBuf); /* * now process the specific directives... */ if (strncmp(cp, "#include", 8) == 0 || strncmp(cp, "#sinclude", 8) == 0) { bool sinclude = cp[1] == 's'; cps = cp + 8 + sinclude; /* skip whitespace */ for ( ; cps < cpEND && (*cps == ' ' || *cps == '\t'); cps++) ; /* skip possible quotation mark or opening angle bracket */ if (*cps == '"' || *cps == '<') cps++; /* check for EOL */ if (*cps == '\n') { ePerl_SetError("Missing filename or URL for #%.*sinclude directive", sinclude, "s"); goto CUS; } /* grab the filename, skip to end of line later */ char *caName = cps; while ( cps < cpEND && (*cps != ' ' && *cps != '\t' && *cps != '>' && *cps != '"' && *cps != '\n' )) ++cps; char orig = *cps; *cps = '\0'; /* recursive usage */ struct span loaded = ePerl_PP_Process(caName, cppINC, cppINCLen, ppmode_file, ePerl_begin_delimiter, ePerl_end_delimiter, ePerl_case_sensitive_delimiters); *cps = orig; if (!loaded.str) goto CUS; if (sinclude) { /* make it secure by removing all begin/end delimiters!! */ #define KILLDEL(delimiter) \ size_t delimiter##_len = strlen(delimiter); \ for (char *del; (del = (ePerl_case_sensitive_delimiters ? memmem : memcasemem)(loaded.str, loaded.len, delimiter, delimiter##_len));) { \ memmove(del, del + delimiter##_len, loaded.len - (del + delimiter##_len - loaded.str)); \ loaded.len -= delimiter##_len; \ } KILLDEL(ePerl_begin_delimiter) KILLDEL(ePerl_end_delimiter) } fwrite(loaded.str, 1, loaded.len, OutBuf); free(loaded.str); } else if (strncmp(cp, "#if", 3) == 0 || strncmp(cp, "#elsif", 6) == 0) { bool elsif = cp[1] == 'e'; cps = cp + (elsif ? 6 : 3); /* skip whitespaces */ for ( ; cps < cpEND && (*cps == ' ' || *cps == '\t'); cps++) ; if (*cps == '\n') { ePerl_SetError("Missing expression for #%sif directive", elsif ? "els" : ""); goto CUS; } /* copy the argument and create replacement string */ char *argstart = cps; while (*cps && *cps != '\n') ++cps; char orig = *cps; *cps = '\0'; fprintf(OutBuf, "%s %sif (%s) { _%s//\n", ePerl_begin_delimiter, elsif ? "} els" : "", argstart, ePerl_end_delimiter); *cps = orig; } else if (strncmp(cp, "#else", 5) == 0) { cps = cp+5; fprintf(OutBuf, "%s } else { _%s//\n", ePerl_begin_delimiter, ePerl_end_delimiter); } else if (strncmp(cp, "#endif", 6) == 0) { cps = cp+6; fprintf(OutBuf, "%s } _%s//\n", ePerl_begin_delimiter, ePerl_end_delimiter); } else if (strncmp(cp, "#c", 2) == 0) { cps = cp+2; /* completely discard line */ } /* skip to end of line */ for ( ; cps < cpEND && *cps != '\n'; cps++) ; if (*cps == '\n') cps++; } else { /* no more found */ /* add data */ fputs(cps, OutBuf); break; } } if (fclose(OutBuf)) goto CUS2; ret: if (cpInBuf) free(cpInBuf); return ret; CUS: fclose(OutBuf); CUS2: free(ret.str); ret = (struct span){}; goto ret; } char *ePerl_PP(char *cpBuf, const char *const *cppINC, size_t cppINCLen, const char *ePerl_begin_delimiter, const char *ePerl_end_delimiter, bool ePerl_case_sensitive_delimiters) { return ePerl_PP_Process(cpBuf, cppINC, cppINCLen, ppmode_buffer, ePerl_begin_delimiter, ePerl_end_delimiter, ePerl_case_sensitive_delimiters).str; } ossp-eperl-ePerl_2_2_15/eperl_security.h000066400000000000000000000030701470477324200204040ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #ifndef EPERL_SECURITY_H #define EPERL_SECURITY_H 1 /* * General security for CGI modes */ #define CGI_NEEDS_ALLOWED_FILE_EXT true static const char *const allowed_file_ext[] = { ".html", ".phtml", ".eperl", ".ephtml", ".epl", ".pl", ".cgi" }; /* * Perl security * (BE CAREFUL HERE, THIS CAN MAKE YOUR LIFE HARD!) */ #define CGI_MODES_FORCE_TAINTING false #define CGI_MODES_FORCE_WARNINGS false /* * SetUID security checks for CGI modes: * You can enable/disable any checked steps here. */ #define SETUID_NEEDS_VALID_CALLER_UID true #define SETUID_NEEDS_ALLOWED_CALLER_UID true #define SETUID_NEEDS_VALID_OWNER_UID true #define SETUID_NEEDS_VALID_OWNER_GID true #define SETUID_NEEDS_BELOW_OWNER_HOME true static const char *const allowed_caller_uid[] = { ALLOWED_CALLER_UID }; /* * Action when a SetUID security check failed. * * Define "DO_FOR_FAILED_STEP" to one of the following: * * MARK_AND_GO_ON: step is marked as failed and processing goes on. * BUT: No UID/GID switching takes place! * (default) * * STOP_AND_ERROR: immediately stop processing print an error. * (for the paranoid webmaster who really * wants to enable ePerl only succeded UID/GID * switching) */ #define MARK_AND_GO_ON 1 #define STOP_AND_ERROR 2 #define DO_FOR_FAILED_STEP MARK_AND_GO_ON #endif /* EPERL_SECURITY_H */ ossp-eperl-ePerl_2_2_15/eperl_sys.c000066400000000000000000000065361470477324200173600ustar00rootroot00000000000000/* SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall */ #include "eperl.h" #include #include void putenvf(const char *fmt, ...) { char *cp; va_list ap; va_start(ap, fmt); vasprintf(&cp, fmt, ap); va_end(ap); putenv(cp); } /* ** I/O handle redirection */ #define IO_REDIRECT_STD(outerr, num) \ static int IO_redirected_std##outerr = -1; \ void IO_redirect_std##outerr(int fd) \ { \ IO_redirected_std##outerr = fcntl(num, F_DUPFD_CLOEXEC, 0); \ dup2(fd, num); \ } \ void IO_restore_std##outerr(void) \ { \ if (IO_redirected_std##outerr != -1) { \ dup2(IO_redirected_std##outerr, num); \ close(IO_redirected_std##outerr); \ IO_redirected_std##outerr = -1; \ } \ } IO_REDIRECT_STD(out, 1) IO_REDIRECT_STD(err, 2) /* ** Temporary filename support */ static char *mytmpfiles[tmpfile_cnt]; struct tmpfile mytmpfile(enum tmpfile_id id) { asprintf(&mytmpfiles[id], "%s/%cPerl.XXXXXXXXXX", getenv("TMPDIR") ?: "/tmp", 'e' + id); int fd = mkostemp(mytmpfiles[id], O_CLOEXEC); if (fd == -1) mytmpfiles[id] = NULL; return (struct tmpfile){mytmpfiles[id], fd}; } void remove_mytmpfiles(void) { for (size_t i = 0; i != tmpfile_cnt; ++i) if (mytmpfiles[i]) unlink(mytmpfiles[i]); } bool ePerl_CopyFILE(FILE *from, FILE *to) { char buf[64 * 1024]; for (size_t rd = sizeof(buf); rd == sizeof(buf); ) { rd = fread(buf, 1, sizeof(buf), from); fwrite(buf, 1, rd, to); } return !ferror(from); } /* ** read source file into internal buffer */ bool ePerl_ReadSourceFile(const char *filename, char **cpBufC, size_t *nBufC) { bool rc = true; FILE *fp = fopen(filename, "r"), *out = NULL; if (fp == NULL) { ePerl_SetError("Cannot open source file %s for reading", filename); CU(false); } out = open_memstream(cpBufC, nBufC); if (!ePerl_CopyFILE(fp, out)) { ePerl_SetError("Cannot read from file %s", filename); CU(false); } CUS: if (fp) fclose(fp); if (out) if (fclose(out)) { ePerl_SetError("Cannot allocate for %s: %s", filename, strerror(errno)); rc = false; } return rc; } /* ** read an error file to internal buffer and substitute the filename */ void ePerl_SubstErrorLog(char **cpBuf, size_t *nBuf, const char *replace, const char *with) { size_t replace_len = strlen(replace); size_t with_len = strlen(with); ++*nBuf; for (size_t cur = 0; ;) { char *path = memmem(*cpBuf + cur, *nBuf - cur, replace, replace_len); if (!path) break; cur = path - *cpBuf; char *newBuf = with_len > replace_len ? realloc(*cpBuf, *nBuf + with_len - replace_len) : *cpBuf; if (!newBuf) break; memmove(newBuf + cur + with_len, newBuf + cur + replace_len, *nBuf - cur - replace_len); *cpBuf = newBuf; *nBuf += with_len - replace_len; memcpy(*cpBuf + cur, with, with_len); cur += with_len; } --*nBuf; } ossp-eperl-ePerl_2_2_15/mod/000077500000000000000000000000001470477324200157545ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/mod/MANIFEST000066400000000000000000000004021470477324200171010ustar00rootroot00000000000000MANIFEST README Makefile.PL Parse/MANIFEST Parse/Makefile.PL Parse/README Parse/ePerl.pm Parse/ePerl.xs Parse/t/01_load.t Parse/t/02_preprocess.t Parse/t/03_translate.t Parse/t/04_precompile.t Parse/t/05_evaluate.t Parse/t/06_expand.t Parse/t/07_delimiter.t ossp-eperl-ePerl_2_2_15/mod/Makefile.PL000066400000000000000000000002431470477324200177250ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Parse::ePerl', 'DIR' => ['Parse'], ); ossp-eperl-ePerl_2_2_15/mod/Parse/000077500000000000000000000000001470477324200170265ustar00rootroot00000000000000ossp-eperl-ePerl_2_2_15/mod/Parse/MANIFEST000066400000000000000000000002361470477324200201600ustar00rootroot00000000000000MANIFEST Makefile.PL README ePerl.pm ePerl.xs t/01_load.t t/02_preprocess.t t/03_translate.t t/04_precompile.t t/05_evaluate.t t/06_expand.t t/07_delimiter.t ossp-eperl-ePerl_2_2_15/mod/Parse/Makefile.PL000066400000000000000000000003761470477324200210060ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Parse::ePerl', 'VERSION_FROM' => 'ePerl.pm', 'INC' => "-I../..", 'LIBS' => ["-L../.. -leperl"], ); ossp-eperl-ePerl_2_2_15/mod/Parse/README000066400000000000000000000010041470477324200177010ustar00rootroot00000000000000 Parse::ePerl ============ This module is the Perl 5 glue code which makes the ePerl parser available as an integrated Perl module named Parse::ePerl which can be used to transform a sprinkled source code buffer into an expanded source code buffer. CPAN Module List Entry: Name DSLI Description Info ------------- ---- -------------------------------------------- ----- Parse:: ::ePerl Rdcr Embedded Perl (ePerl) parser RSE ossp-eperl-ePerl_2_2_15/mod/Parse/ePerl.pm.in000066400000000000000000000312041470477324200210400ustar00rootroot00000000000000# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-2.0-only ## Copyright (c) 1996,1997 Ralf S. Engelschall, All rights reserved. package Parse::ePerl; # requirements and runtime behaviour require 5.00325; use strict; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); # imports require Exporter; require DynaLoader; require AutoLoader; use Carp; use Cwd qw(fastcwd); #use Safe; # interface @ISA = qw(Exporter DynaLoader); @EXPORT = qw(); # private version number $VERSION = do { my @v=("@EPERL_VERSION_SHORT@"=~/\d+/g); sprintf "%d."."%02d"x$#v,@v }; # dynaloader bootstrapping bootstrap Parse::ePerl $VERSION; # untainting a variable: for restricted environments sub Untaint { my ($var) = @_; # see perlsec(1) ${$var} =~ m|^(.*)$|s; ${$var} = $1; } ## Preprocess -- run the ePerl preprocessor over the script ## which expands #include directives sub Preprocess ($) { my ($p) = @_; my ($result, $ocwd); # error if no input or no output if ( not $p->{Script} || not $p->{Result}) { return 0; } # set defaults $p->{INC} ||= []; $p->{BeginDelimiter} ||= '<:'; $p->{EndDelimiter} ||= ':>'; # switch to directory of file if ($p->{Cwd}) { Untaint(\$p->{Cwd}); $ocwd = fastcwd(); chdir($p->{Cwd}); } # use XS part: PP (preprocessor) $result = PP( $p->{Script}, $p->{INC}, $p->{BeginDelimiter}, $p->{EndDelimiter} ); # restore Cwd chdir($ocwd) if ($p->{Cwd}); if ($result eq '') { return 0; } else { ${$p->{Result}} = $result; return 1; } } ## Translate -- translate a plain Perl script from ## sprinkled code to plain Perl code sub Translate ($) { my ($p) = @_; my ($result); # error if no input or no output if ( not $p->{Script} || not $p->{Result}) { return 0; } # set defaults $p->{BeginDelimiter} ||= '<:'; $p->{EndDelimiter} ||= ':>'; $p->{CaseDelimiters} ||= 0; $p->{ConvertEntities} ||= 0; # use XS part: Bristled2Plain $result = Bristled2Plain( $p->{Script}, $p->{BeginDelimiter}, $p->{EndDelimiter}, $p->{CaseDelimiters}, $p->{ConvertEntities} ); if ($result eq '') { return 0; } else { ${$p->{Result}} = $result; return 1; } } ## Precompile -- precompile a plain Perl script to ## internal Perl code (P-code) by storing ## the script into a subroutine sub Precompile ($) { my ($p) = @_; my ($error, $func, $ocwd); # error if no input or no output if ( not $p->{Script} || not $p->{Result}) { return 0; } # capture the warning messages which # usually are send to STDERR and # disable the die of the interpreter $error = ''; local $SIG{'__WARN__'} = sub { $error .= $_[0]; }; local $SIG{'__DIE__'}; # switch to directory of file if ($p->{Cwd}) { Untaint(\$p->{Cwd}); $ocwd = fastcwd(); chdir($p->{Cwd}); } # precompile the source into P-code #my $cp = new Safe("Safe::ePerl"); #$func = $cp->reval('$func = sub {'.$p->{Script}.'};'); Untaint(\$p->{Script}); eval("\$func = sub {" . $p->{Script} . "};"); $error = "$@" if ($@); # restore Cwd chdir($ocwd) if ($p->{Cwd}); # return the result if ($error) { $error =~ s|\(eval \d+\)|$p->{Name}| if ($p->{Name}); ${$p->{Error}} = $error if ($p->{Error}); $@ = $error; return 0; } else { ${$p->{Result}} = $func; $@ = ''; return 1; } } ## Evaluate -- evaluate a script which is either ## give as a P-code reference or as ## a plain Perl script sub Evaluate ($) { my ($p) = @_; my ($stdout, $stderr, %OENV, $ocwd); my ($result, $error); # error if no input or no output if ( not $p->{Script} || not $p->{Result}) { return 0; } # capture STDOUT and STDERR $stdout = tie(*STDOUT, 'Parse::ePerl'); $stderr = tie(*STDERR, 'Parse::ePerl'); # setup the environment if ($p->{ENV}) { %OENV = %ENV; %ENV = %{$p->{ENV}}; } # switch to directory of file if ($p->{Cwd}) { $ocwd = fastcwd(); chdir($p->{Cwd}); } # capture the warning messages which # usually are send to STDERR (and which # cannot be captured by our tie!) plus # disable the die of the interpreter $error = ''; local $SIG{'__WARN__'} = sub { $error .= $_[0]; }; local $SIG{'__DIE__'} = sub { $error .= $_[0]; }; # now evaluate the script which # produces content on STDOUT and perhaps # additionally on STDERR if (ref($p->{Script})) { # a P-code reference &{$p->{Script}}; } else { # a plain code string eval $p->{Script}; } # retrieve captured data from STDOUT $result = ${$stdout}; # retrieve either the error message # (on syntax errors) or the generated data # on STDERR (when generated by the script) $error ||= ${$stderr}; $error =~ s|\(eval \d+\)|$p->{Name}| if (defined($error) && $p->{Name}); # restore Cwd chdir($ocwd) if ($p->{Cwd}); # restore environment %ENV = %OENV if ($p->{ENV}); # remove capturing mode from STDOUT/STDERR undef($stdout); undef($stderr); untie(*STDOUT); untie(*STDERR); # set the result ${$p->{Result}} = $result; ${$p->{Error}} = $error if ($p->{Error}); # return the result codes if ($error) { $@ = $error; return 0; } else { $@ = ''; return 1; } } ## Expand -- the steps Translate & Evaluate ## just combined into one step sub Expand ($) { my ($p) = @_; my ($rc, $script); # error if no input or no output if ( not $p->{Script} || not $p->{Result}) { return 0; } if (not Translate($p)) { return 0; } $script = $p->{Script}; $p->{Script} = ${$p->{Result}}; $rc = Evaluate($p); $p->{Script} = $script; return $rc; } ## Capture -- methods for capturing a filehandle ## (used by Evaluate) via this class sub TIEHANDLE { my ($class, $c) = @_; return bless(\$c,$class); } sub PRINT { my ($self) = shift; ${$self} .= join('', @_); } sub PRINTF { my ($self) = shift; my ($fmt) = shift; ${$self} .= sprintf($fmt, @_); } # sometimes Perl wants it... sub DESTROY { }; 1; __END__ =head1 NAME Parse::ePerl - Perl interface to the ePerl parser =head1 SYNOPSIS use Parse::ePerl; $rc = Parse::ePerl::Preprocess($p); $rc = Parse::ePerl::Translate($p); $rc = Parse::ePerl::Precompile($p); $rc = Parse::ePerl::Evaluate($p); $rc = Parse::ePerl::Expand($p); =head1 DESCRIPTION Parse::ePerl is the Perl 5 interface package to the functionality of the ePerl parser (see eperl(1) for more details about the stand-alone program). It directly uses the parser code from ePerl to translate a sprinkled script into a plain Perl script and additionally provides functions to precompile such scripts into P-code and evaluate those scripts to a buffer. All functions are parameterized via a hash reference C<$p> which provide the necessary parameters. The result is a return code C<$rc> which indicates success (1) or failure (0). =head2 B This is the ePerl preprocessor which expands C<#include> directives. See eperl(1) for more details. Possible parameters for C<$p>: =over 4 =item I