thomas.bellembois
/
codefirst-dockerproxy
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First commit.

Browse Source
master
Thomas Bellembois 2 years ago
commit 483db4d7ba
81 changed files with 4583 additions and 0 deletions
Show Stats Download Patch File Download Diff File

10
Dockerfile
Unescape View File

@ -0,0 +1,10 @@
FROM debian:bookworm as builder
COPY bin/dockerproxy-main /bin/dockerproxy-main
COPY docker/entrypoint.sh /
RUN chmod +x /entrypoint.sh
USER root
EXPOSE 8080
ENTRYPOINT [ "/entrypoint.sh" ]

38
Dockerfile-new
Unescape View File

@ -0,0 +1,38 @@
FROM debian:bookworm as builder
RUN apt -y update && apt -y install unzip git curl gnat
RUN mkdir -p /usr/local/src/alr
ADD https://github.com/alire-project/alire/releases/download/v1.2.2/alr-1.2.2-bin-x86_64-linux.zip /usr/local/src/alr/alr.zip
RUN cd /usr/local/src/alr && unzip alr.zip && rm -f alr.zip
ENV PATH="$PATH:/usr/local/src/alr/bin"
WORKDIR /root
RUN mkdir -p /root/.config/alire
RUN alr -d get --build gnat_native
RUN alr -d get --build gprbuild
RUN alr toolchain
COPY docker/config.toml /root/.config/alire/
RUN mkdir -p /usr/local/src/codefirst-dockerproxy
WORKDIR /usr/local/src/codefirst-dockerproxy
COPY . .
RUN ls -la
RUN alr -d build
# FROM debian:bookwork
# COPY --from=builder /usr/local/codefirst-dockerproxy/greet /bin/greet
# COPY docker/entrypoint.sh /
# RUN chmod +x /entrypoint.sh
# USER root
# EXPOSE 8080
# ENTRYPOINT [ "/entrypoint.sh" ]

11
alire.toml
Unescape View File

@ -0,0 +1,11 @@
name = "codefirst_dockerproxy"
description = "Shiny new project"
version = "0.1.0-dev"
authors = ["Thomas Bellembois"]
maintainers = ["Thomas Bellembois <thomas.bellembois@uca.fr>"]
maintainers-logins = ["tbellembois"]
executables = ["codefirst_dockerproxy"]
[[depends-on]]
aws = "^23.0.0"

30
codefirst_dockerproxy.gpr
Unescape View File

@ -0,0 +1,30 @@
with "config/codefirst_dockerproxy_config.gpr";
with "lib/ada-tokenizer/tokenizer.gpr";
with "lib/gclp/gclp.gpr";
project Codefirst_Dockerproxy is
for Source_Dirs use ("src", "config");
for Object_Dir use "obj/" & Codefirst_Dockerproxy_Config.Build_Profile;
for Create_Missing_Dirs use "True";
for Exec_Dir use "bin";
for Main use ("dockerproxy-main.adb");
package Compiler is
for Default_Switches ("ada") use ("-ffunction-sections", "-fdata-sections", "-g", "-gnat2020", "-O2", "-gnatVa", "-gnatwa.X", "-gnatyaABbc-defhiIklM79nOprStux");
end Compiler;
package Binder is
for Switches ("Ada") use ("-Es"); -- Symbolic traceback
end Binder;
package Install is
for Artifacts (".") use ("share");
end Install;
package Builder is
for Switches ("ada") use ("-j4");
end Builder;
end Codefirst_Dockerproxy;

20
config/codefirst_dockerproxy_config.ads
Unescape View File

@ -0,0 +1,20 @@
-- Configuration for codefirst_dockerproxy generated by Alire
pragma Restrictions (No_Elaboration_Code);
pragma Style_Checks (Off);
package Codefirst_Dockerproxy_Config is
pragma Pure;
Crate_Version : constant String := "0.1.0-dev";
Crate_Name : constant String := "codefirst_dockerproxy";
Alire_Host_OS : constant String := "linux";
Alire_Host_Arch : constant String := "x86_64";
Alire_Host_Distro : constant String := "ubuntu";
type Build_Profile_Kind is (release, validation, development);
Build_Profile : constant Build_Profile_Kind := development;
end Codefirst_Dockerproxy_Config;

50
config/codefirst_dockerproxy_config.gpr
Unescape View File

@ -0,0 +1,50 @@
-- Configuration for codefirst_dockerproxy generated by Alire
with "aws.gpr";
abstract project Codefirst_Dockerproxy_Config is
Crate_Version := "0.1.0-dev";
Crate_Name := "codefirst_dockerproxy";
Alire_Host_OS := "linux";
Alire_Host_Arch := "x86_64";
Alire_Host_Distro := "ubuntu";
Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " ");
Ada_Compiler_Switches := Ada_Compiler_Switches &
(
"-Og" -- Optimize for debug
,"-ffunction-sections" -- Separate ELF section for each function
,"-fdata-sections" -- Separate ELF section for each variable
,"-g" -- Generate debug info
,"-gnatwa" -- Enable all warnings
,"-gnatw.X" -- Disable warnings for No_Exception_Propagation
,"-gnatVa" -- All validity checks
,"-gnaty3" -- Specify indentation level of 3
,"-gnatya" -- Check attribute casing
,"-gnatyA" -- Use of array index numbers in array attributes
,"-gnatyB" -- Check Boolean operators
,"-gnatyb" -- Blanks not allowed at statement end
,"-gnatyc" -- Check comments
,"-gnaty-d" -- Disable check no DOS line terminators present
,"-gnatye" -- Check end/exit labels
,"-gnatyf" -- No form feeds or vertical tabs
,"-gnatyh" -- No horizontal tabs
,"-gnatyi" -- Check if-then layout
,"-gnatyI" -- check mode IN keywords
,"-gnatyk" -- Check keyword casing
,"-gnatyl" -- Check layout
,"-gnatym" -- Check maximum line length
,"-gnatyn" -- Check casing of entities in Standard
,"-gnatyO" -- Check that overriding subprograms are explicitly marked as such
,"-gnatyp" -- Check pragma casing
,"-gnatyr" -- Check identifier references casing
,"-gnatyS" -- Check no statements after THEN/ELSE
,"-gnatyt" -- Check token spacing
,"-gnatyu" -- Check unnecessary blank lines
,"-gnatyx" -- Check extra parentheses
);
type Build_Profile_Kind is ("release", "validation", "development");
Build_Profile : Build_Profile_Kind := "development";
end Codefirst_Dockerproxy_Config;

20
config/codefirst_dockerproxy_config.h
Unescape View File

@ -0,0 +1,20 @@
/* Configuration for codefirst_dockerproxy generated by Alire */
#ifndef CODEFIRST_DOCKERPROXY_CONFIG_H
#define CODEFIRST_DOCKERPROXY_CONFIG_H
#define CRATE_VERSION "0.1.0-dev"
#define CRATE_NAME "codefirst_dockerproxy"
#define ALIRE_HOST_OS "linux"
#define ALIRE_HOST_ARCH "x86_64"
#define ALIRE_HOST_DISTRO "ubuntu"
#define BUILD_PROFILE_RELEASE 1
#define BUILD_PROFILE_VALIDATION 2
#define BUILD_PROFILE_DEVELOPMENT 3
#define BUILD_PROFILE 3
#endif

13
docker/config.toml
Unescape View File

@ -0,0 +1,13 @@
[toolchain]
assistant = false
[toolchain.external]
gnat = "FALSE"
gprbuild = "FALSE"
[toolchain.use]
gnat = "gnat_native=12.2.1"
gprbuild = "gprbuild=22.0.0"
[user]
email = "thomas.bellembois@uca.fr"
github_login = "tbellembois"
name = "Thomas Bellembois"

53
docker/entrypoint.sh
Unescape View File

@ -0,0 +1,53 @@
#!/usr/bin/env bash
HostName=""
DockerNetworkName=""
DockerPathPrefix=""
Scheme=""
MaxAllowedContainers=""
Admins=""
Devel=""
if [ ! -z "$DEVEL" ]
then
Devel="--devel=$DEVEL"
fi
if [ ! -z "$HOSTNAME" ]
then
HostName="--hostname=$HOSTNAME"
fi
if [ ! -z "$SCHEME" ]
then
Scheme="--scheme=$SCHEME"
fi
if [ ! -z "$ADMINS" ]
then
Admins="--admins=$ADMINS"
fi
if [ ! -z "$DOCKERNETWORKNAME" ]
then
DockerNetworkName="--dockernetworkname=$DOCKERNETWORKNAME"
fi
if [ ! -z "$DOCKERPATHPREFIX" ]
then
DockerPathPrefix="--dockerpathprefix=$DOCKERPATHPREFIX"
fi
if [ ! -z "$MAXALLOWEDCONTAINERS" ]
then
MaxAllowedContainers="--maxallowedcontainers=$MAXALLOWEDCONTAINERS"
fi
echo $Scheme
echo $HostName
echo $DockerNetworkName
echo $DockerPathPrefix
echo $MaxAllowedContainers
echo $Admins
/bin/dockerproxy-main $Devel $Scheme $HostName $DockerNetworkName $DockerPathPrefix $MaxAllowedContainers $Admins

1
lib/ada-tokenizer

@ -0,0 +1 @@
Subproject commit c0714d9103b17429568a68d51bd273950bdce21a

2
lib/gclp/CHANGELOG
Unescape View File

@ -0,0 +1,2 @@
1.0.0 2012-12-14
* First public release

339
lib/gclp/COPYING
Unescape View File

@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 Lesser 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.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 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.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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) year 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.
<signature of Ty Coon>, 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 Lesser General
Public License instead of this License.

44
lib/gclp/README.txt
Unescape View File

@ -0,0 +1,44 @@
** Index **
[1] What is this
[2] How do I install & use it?
[3] Where can I find more documentation?
** [1] What is this? **
This is a small generic package for parsing command line parameters. Yes, I know there are tons of libraries like this around the world, but I find this quite convenient to use.
** [2] How do I install & use it? **
== To install it:
Just copy the two files (generic_line_parser.{ads,adb}) in a place where your Ada compiler will find them. If you use GNAT/GPS, you could want to copy the project file gclp.gpr (that you will "with" from your project file)
== To use it:
The main characteristics of this package are
(1) Parameters are *nominal*, not *positional*. I wrote this package one day I needed to pass a lot of parameters to a program. In that case the positional convention was too "fragile," so I decided to go for the nominal convention. More precisely, the parameters have the form
<name>=<value>
where <name> is any string without "=" or "," and <value> is any string. The value part can also be omitted to obtain parameters of type
<name>
For example, a program (say, foo) using this package could accept a command line like
foo input=from.txt output=to.txt lines=12 fast-compile
Note that since parameters are nominal, the following line is usually equivalent to the line above
foo lines=12 input=from.txt fast-compile output=to.txt
(but order-dependent processing is still possible).
(2) The parameter values are written inside a variable whose type is passed as formal parameter to the package at instantiation time. The variable is written by using some "callbacks" provided by the user of the package. Note with this solution, the variable can be of any type, although the usually it will be a record.
** [3] Where can I find more information? **
(1) You should find a directory doc/ with documentation in HTML format
(2) In the directory test/ you can find an example of usage

0
lib/gclp/bin/generic_line_parser.adb.stderr
Unescape View File

0
lib/gclp/bin/generic_line_parser.adb.stdout
Unescape View File

7
lib/gclp/bin/generic_line_parser.cswi
Unescape View File

@ -0,0 +1,7 @@
20230124145449
-c
-x
ada
-gnatA
-gnata
-g

177
lib/gclp/doc/generic_line_parser.ads.html
Unescape View File

@ -0,0 +1,177 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Package: Generic_Line_Parser (generic)
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<link rel='stylesheet' href='support/tags.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<a href='index.html'><div class="button2">Table of Contents</div></a>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
<div id='navigation'>
<h2 class="button">Navigation</h2>
<a href='#Description'><div class="button2">Description</div></a>
<a href='#Types'><div class="button2">Types</div></a>
<a href='#Constants'><div class="button2">Constants &amp; Global variables</div></a>
<a href='#Methods'><div class="button2">Subprograms &amp; Entries</div></a>
</div><!-- navigation -->
</div>
</div> <!-- leftSide -->
<div class='default' id='rightSide'>
<div id='rightSideInside'>
<div id='Index'>
<h2>Index</h2>
<script type="text/javascript">
var names = new Array (
new Array ('Parameter_<wbr/>Callback', 'generic_line_parser.ads:60:9', 'type-spec'),
new Array ('Parameter_<wbr/>Descriptor', 'generic_line_parser.ads:65:9', 'type-spec'),
new Array ('Parameter_<wbr/>Descriptor_<wbr/>Array', 'generic_line_parser.ads:85:9', 'type-spec'),
new Array ('Bad_<wbr/>Command', 'generic_line_parser.ads:98:4', 'var-spec'),
new Array ('Parse_<wbr/>Command_<wbr/>Line', 'generic_line_parser.ads:92:14', 'subp-spec'),
new Array ('To_<wbr/>Float', 'generic_line_parser.ads:103:13', 'subp-spec'),
new Array ('To_<wbr/>Natural', 'generic_line_parser.ads:108:13', 'subp-spec'),
new Array ('dummy', '', ''));
printIndexList (names);
</script>
<noscript>
<ul>
<li class='type-spec'><a href="#generic_line_parser.ads:60:9">Parameter_<wbr/>Callback</a></li>
<li class='type-spec'><a href="#generic_line_parser.ads:65:9">Parameter_<wbr/>Descriptor</a></li>
<li class='type-spec'><a href="#generic_line_parser.ads:85:9">Parameter_<wbr/>Descriptor_<wbr/>Array</a></li>
<li class='var-spec'><a href="#generic_line_parser.ads:98:4">Bad_<wbr/>Command</a></li>
<li class='subp-spec'><a href="#generic_line_parser.ads:92:14">Parse_<wbr/>Command_<wbr/>Line</a></li>
<li class='subp-spec'><a href="#generic_line_parser.ads:103:13">To_<wbr/>Float</a></li>
<li class='subp-spec'><a href="#generic_line_parser.ads:108:13">To_<wbr/>Natural</a></li>
</ul>
</noscript>
</div>
</div>
</div>
<div class='default' id='documentation'>
<div class='title'>
Package: <i>Generic_Line_Parser (generic)</i>
(<a href="src_generic_line_parser.ads.html">Source File</a>)
</div>
<div class='subprograms'>
<h1><a name='Description' id='Description'></a>Description</h1>
<div class="class">
<div class='details'><pre><span class="keyword">generic</span>
<span class="keyword">type</span> <span class="name"><a name="generic_line_parser.ads:49:9"></a>Config_Data</span> <span class="keyword">is</span> <span class="keyword">limited</span> <span class="keyword">private</span>;
<span class="comment">-- The parameters read from the command line will be written in
</span> <span class="comment">-- a variable of this type
</span>
<span class="comment">-- Set this to False if you want case insensitive option matching.
</span> <span class="comment">-- For example, if you set this to False, "input", "Input", "INPUT"
</span> <span class="comment">-- and "InPuT" will be equivalent names for the option "input"
</span> <span class="name"><a name="generic_line_parser.ads:56:4"></a>Case_Sensitive</span> : Boolean := True;
<span class="keyword">package</span> <span class="name"><b>Generic_Line_Parser</b></span> <span class="keyword">is</span></pre></div>
<div class='comment'><div class="summary" ><p>This is a generic package implementing a simple-to-use command line parser. Yes, I know, everyone makes his/her own command line parser... so, I wrote mine. As they say, every open source project starts with a programmer that schratches hes own itch. So I did... If you find this useful, you are welcome to use it. </p><p>The ideas behind this package are the following </p><p>* Parameters are nominal, non positional. The syntax is of "named parameter" type, that is, each command line parameter is expected to have thefollowing format </p><p>label ['=' value] </p><p>where "label" is any string without '='. </p><p>* Parsed value are written in a "configuration variable" whose type is a formal parameter of this package. The values are written in the configuration variable by using some callbacks provided by caller. </p><p>The names of the parameters are given to the parser in "parameter description array" that is an array of records that specify </p><p>+ The parameter name </p><p>+ A default value (if needed) </p><p>+ If the parameter is mandatory </p><p>+ If it can be specified more than once </p><p>+ The callback function to be called when the parameter is found </p><p>In order to parse the command line it suffices to call Parse_Command_Line giving as argument the array of parameter descriptors and the configuration variable to be written. For every parameter found, the corresponding callback function is called. If at the end of the parsing there are some optional parameters that were missing from the command line, the corresponding callbacks are called with the default parameter.</p></div></div>
</div>
</div>
<div class='subprograms'>
<h1><a name='Types' id='Types'></a>Types</h1>
<div class="class">
<h3>
<a name='generic_line_parser.ads:60:9' id='generic_line_parser.ads:60:9'></a>Parameter_Callback
- <a href="src_generic_line_parser.ads.html#60" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">type</span> <span class="name"><b>Parameter_Callback</b></span> <span class="keyword">is</span>
<span class="keyword">access</span> <span class="keyword">procedure</span> (Name : <span class="keyword">in</span> Unbounded_String;
Value : <span class="keyword">in</span> Unbounded_String;
Result : <span class="keyword">in</span> <span class="keyword">out</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:49:9" title="defined at generic_line_parser.ads:49:9">Config_Data</a>);</pre></div>
</div>
<div class="class">
<h3>
<a name='generic_line_parser.ads:65:9' id='generic_line_parser.ads:65:9'></a>Parameter_Descriptor
- <a href="src_generic_line_parser.ads.html#65" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">type</span> <span class="name"><b>Parameter_Descriptor</b></span> <span class="keyword">is</span>
<span class="keyword">record</span>
Name : Unbounded_String; <span class="comment">-- Parameter name
</span> Default : Unbounded_String; <span class="comment">-- Default value used if not on C.L.
</span> Mandatory : Boolean; <span class="comment">-- Parameter MUST be given
</span> Only_Once : Boolean; <span class="comment">-- Parameter MUST NOT be given more than once
</span> Callback : <a href="generic_line_parser.ads.html#generic_line_parser.ads:60:9" title="defined at generic_line_parser.ads:60:9">Parameter_Callback</a>; <span class="comment">-- Called when parameter found
</span> <span class="keyword">end</span> <span class="keyword">record</span>;</pre></div>
<div class='comment'><div class="description" >Record holding the description of a parameter. The fields should be self-explenatory (I hope). The only field that needs some explanation is Name since it allows to specify more than one name for each parameter. The syntax is very simple: just separate the names with commas. For example, if Name is "f,filename,input" one can use on the command line, with the same effect f=/tmp/a.txt or filename=/tmp/a.txt or input=/tmp/a.txt. Spaces at both ends of the label name are trimmed, so that, for example, "f,filename,input" is equivalent to "f , filename ,input "</div></div>
</div>
<div class="class">
<h3>
<a name='generic_line_parser.ads:85:9' id='generic_line_parser.ads:85:9'></a>Parameter_Descriptor_Array
- <a href="src_generic_line_parser.ads.html#85" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">type</span> <span class="name"><b>Parameter_Descriptor_Array</b></span> <span class="keyword">is</span>
<span class="keyword">array</span> (Natural <span class="keyword">range</span> <>) <span class="keyword">of</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:65:9" title="defined at generic_line_parser.ads:65:9">Parameter_Descriptor</a>;</pre></div>
</div>
</div>
<div class='subprograms'>
<h1><a name='Constants' id='Constants'></a>Constants &amp; Global variables</h1>
<div class="class">
<h3><a name='generic_line_parser.ads:98:4' id='generic_line_parser.ads:98:4'></a>Bad_Command
- <a href="src_generic_line_parser.ads.html#98" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="name"><b>Bad_Command</b></span> : <span class="keyword">exception</span>;</pre></div>
</div>
</div>
<div class='subprograms'>
<h1><a name='Methods' id='Methods'></a>Subprograms &amp; Entries</h1>
<div class="class">
<h3>
<a name='generic_line_parser.ads:92:14' id='generic_line_parser.ads:92:14'></a>Parse_Command_Line
- <a href="src_generic_line_parser.ads.html#92" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">procedure</span> <span class="name"><b>Parse_Command_Line</b></span> <table><tr><td>(</td><td><span class="name"><a name="generic_line_parser.ads:93:7"></a>Parameters</span></td><td>: <span class="keyword">in</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:85:9" title="defined at generic_line_parser.ads:85:9">Parameter_Descriptor_Array</a>;</td></tr><tr><td></td><td><span class="name"><a name="generic_line_parser.ads:94:7"></a>Result</span></td><td>: <span class="keyword">out</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:49:9" title="defined at generic_line_parser.ads:49:9">Config_Data</a>;</td></tr><tr><td></td><td><span class="name"><a name="generic_line_parser.ads:95:7"></a>Help_Line</span></td><td>: <span class="keyword">in</span> String := <span class="string">""</span>;</td></tr><tr><td></td><td><span class="name"><a name="generic_line_parser.ads:96:7"></a>Help_Output</span></td><td>: <span class="keyword">in</span> Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Error);</td></tr></table></pre></div>
<div class='comment'>Main exported method. It parses the command line and it writes
the result in Result. If some error is encountered, Bad_Command
is raised with an explicative exception message. Help_Line,
if not empty, is written to Help_Output in case of error.
</div>
</div>
<div class="class">
<h3>
<a name='generic_line_parser.ads:103:13' id='generic_line_parser.ads:103:13'></a>To_Float
- <a href="src_generic_line_parser.ads.html#103" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">function</span> <span class="name"><b>To_Float</b></span> <table><tr><td>(</td><td><span class="name"><a name="generic_line_parser.ads:103:23"></a>X</span></td><td>: Unbounded_String)</td></tr></table><span class="keyword">return</span> Float;</pre></div>
<div class='comment'>Convenient conversion function to Float that raise Bad_Command if
the argument has not a valid syntax
</div>
</div>
<div class="class">
<h3>
<a name='generic_line_parser.ads:108:13' id='generic_line_parser.ads:108:13'></a>To_Natural
- <a href="src_generic_line_parser.ads.html#108" title="Goto spec">Spec</a>
</h3>
<div class='details'><pre><span class="keyword">function</span> <span class="name"><b>To_Natural</b></span> <table><tr><td>(</td><td><span class="name"><a name="generic_line_parser.ads:108:25"></a>X</span></td><td>: Unbounded_String)</td></tr></table><span class="keyword">return</span> Natural;</pre></div>
<div class='comment'>Convenient conversion function to Float that raise Bad_Command if
the argument has not a valid syntax
</div>
</div>
</div>
</div> <!-- documentation -->
</body>
</html>

61
lib/gclp/doc/index.html
Unescape View File

@ -0,0 +1,61 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<b>G</b>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<a href="indexeG.html">G</a>]
[<a href="indexeP.html">P</a>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Packages and source files (G):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:57:9" title="defined at generic_line_parser.ads:57:9">Generic_Line_Parser</a>
(<b>package</b>)
at <i>generic_line_parser.ads:57:9</i>
</div>
</body>
</html>

61
lib/gclp/doc/indexeB.html
Unescape View File

@ -0,0 +1,61 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<a href="indexfG.html">G</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<b>B</b>]
[<a href="indexeG.html">G</a>]
[<a href="indexeP.html">P</a>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Entities (B):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:98:4" title="defined at generic_line_parser.ads:98:4">Bad_Command</a>
(<b>constant or variable</b>)
at <i>generic_line_parser.ads:98:4</i>
</div>
</body>
</html>

61
lib/gclp/doc/indexeG.html
Unescape View File

@ -0,0 +1,61 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<a href="indexfG.html">G</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<b>G</b>]
[<a href="indexeP.html">P</a>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Entities (G):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:57:9" title="defined at generic_line_parser.ads:57:9">Generic_Line_Parser</a>
(<b>package</b>)
at <i>generic_line_parser.ads:57:9</i>
</div>
</body>
</html>

76
lib/gclp/doc/indexeP.html
Unescape View File

@ -0,0 +1,76 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<a href="indexfG.html">G</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<a href="indexeG.html">G</a>]
[<b>P</b>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Entities (P):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:60:9" title="defined at generic_line_parser.ads:60:9">Parameter_Callback</a>
(<b>type</b>)
at <i>generic_line_parser.ads:60:9</i>
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:65:9" title="defined at generic_line_parser.ads:65:9">Parameter_Descriptor</a>
(<b>type</b>)
at <i>generic_line_parser.ads:65:9</i>
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:85:9" title="defined at generic_line_parser.ads:85:9">Parameter_Descriptor_Array</a>
(<b>type</b>)
at <i>generic_line_parser.ads:85:9</i>
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:92:14" title="defined at generic_line_parser.ads:92:14">Parse_Command_Line</a>
(<b>subprogram</b>)
at <i>generic_line_parser.ads:92:14</i>
</div>
</body>
</html>

66
lib/gclp/doc/indexeT.html
Unescape View File

@ -0,0 +1,66 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<a href="indexfG.html">G</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<a href="indexeG.html">G</a>]
[<a href="indexeP.html">P</a>]
[<b>T</b>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Entities (T):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:103:13" title="defined at generic_line_parser.ads:103:13">To_Float</a>
(<b>subprogram</b>)
at <i>generic_line_parser.ads:103:13</i>
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:108:13" title="defined at generic_line_parser.ads:108:13">To_Natural</a>
(<b>subprogram</b>)
at <i>generic_line_parser.ads:108:13</i>
</div>
</body>
</html>

61
lib/gclp/doc/indexfG.html
Unescape View File

@ -0,0 +1,61 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<b>G</b>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<a href="indexeG.html">G</a>]
[<a href="indexeP.html">P</a>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<a href="indexsG.html">G</a>]
</div>
</div>
</div>
<div class='titleTopBar'>
Packages and source files (G):
</div>
<div class="entity">
<a href="generic_line_parser.ads.html#generic_line_parser.ads:57:9" title="defined at generic_line_parser.ads:57:9">Generic_Line_Parser</a>
(<b>package</b>)
at <i>generic_line_parser.ads:57:9</i>
</div>
</body>
</html>

59
lib/gclp/doc/indexsG.html
Unescape View File

@ -0,0 +1,59 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Table of Contents
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<i><div class="button2">Table of Contents</div></i>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div>
<div class='topBar'>
<div class='topBarInside'>
<div class='topBarLinks'>
<b>Table of Contents</b>
</div>
<div class='topBarLinks' id='fileindex'>
Packages and files Index:
[<a href="indexfG.html">G</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Entities Index:
[<a href="indexeB.html">B</a>]
[<a href="indexeG.html">G</a>]
[<a href="indexeP.html">P</a>]
[<a href="indexeT.html">T</a>]
</div>
<div class='topBarLinks' id='entitiesindex'>
Annotated Source Files:
[<b>G</b>]
</div>
</div>
</div>
<div class='titleTopBar'>
Annotated Source Files (G):
</div>
<div class="entity">
<a href="src_generic_line_parser.ads.html" title="generic_line_parser.ads">generic_line_parser.ads</a>
</div>
</body>
</html>

143
lib/gclp/doc/src_generic_line_parser.ads.html
Unescape View File

@ -0,0 +1,143 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
File: generic_line_parser.ads
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<a href='index.html'><div class="button2">Table of Contents</div></a>
<a href='tree.html'><div class="button2">Class Inheritance Tree</div></a>
</div>
</div>
</div> <!-- leftSide -->
<div class='subprograms'>
<div class='details'><ol><li><pre><a name="1"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="2"></a> </pre></li>
<li><pre><a name="3"></a><span class="comment">-- &lt;summary&gt;</span> </pre></li>
<li><pre><a name="4"></a><span class="comment">-- This is a generic package implementing a simple-to-use command line</span> </pre></li>
<li><pre><a name="5"></a><span class="comment">-- parser. Yes, I know, everyone makes his/her own command line parser...</span> </pre></li>
<li><pre><a name="6"></a><span class="comment">-- so, I wrote mine. As they say, every open source project starts</span> </pre></li>
<li><pre><a name="7"></a><span class="comment">-- with a programmer that schratches hes own itch. So I did... If</span> </pre></li>
<li><pre><a name="8"></a><span class="comment">-- you find this useful, you are welcome to use it.</span> </pre></li>
<li><pre><a name="9"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="10"></a><span class="comment">-- The ideas behind this package are the following</span> </pre></li>
<li><pre><a name="11"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="12"></a><span class="comment">-- * Parameters are nominal, non positional. The syntax is of</span> </pre></li>
<li><pre><a name="13"></a><span class="comment">-- "named parameter" type, that is, each command line parameter is</span> </pre></li>
<li><pre><a name="14"></a><span class="comment">-- expected to have thefollowing format</span> </pre></li>
<li><pre><a name="15"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="16"></a><span class="comment">-- label ['=' value]</span> </pre></li>
<li><pre><a name="17"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="18"></a><span class="comment">-- where "label" is any string without '='.</span> </pre></li>
<li><pre><a name="19"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="20"></a><span class="comment">-- * Parsed value are written in a "configuration variable" whose type</span> </pre></li>
<li><pre><a name="21"></a><span class="comment">-- is a formal parameter of this package. The values are written</span> </pre></li>
<li><pre><a name="22"></a><span class="comment">-- in the configuration variable by using some callbacks provided</span> </pre></li>
<li><pre><a name="23"></a><span class="comment">-- by caller.</span> </pre></li>
<li><pre><a name="24"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="25"></a><span class="comment">-- The names of the parameters are given to the parser in "parameter</span> </pre></li>
<li><pre><a name="26"></a><span class="comment">-- description array" that is an array of records that specify</span> </pre></li>
<li><pre><a name="27"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="28"></a><span class="comment">-- + The parameter name</span> </pre></li>
<li><pre><a name="29"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="30"></a><span class="comment">-- + A default value (if needed)</span> </pre></li>
<li><pre><a name="31"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="32"></a><span class="comment">-- + If the parameter is mandatory</span> </pre></li>
<li><pre><a name="33"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="34"></a><span class="comment">-- + If it can be specified more than once</span> </pre></li>
<li><pre><a name="35"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="36"></a><span class="comment">-- + The callback function to be called when the parameter is found</span> </pre></li>
<li><pre><a name="37"></a><span class="comment">--</span> </pre></li>
<li><pre><a name="38"></a><span class="comment">-- In order to parse the command line it suffices to call Parse_Command_Line</span> </pre></li>
<li><pre><a name="39"></a><span class="comment">-- giving as argument the array of parameter descriptors and the configuration</span> </pre></li>
<li><pre><a name="40"></a><span class="comment">-- variable to be written. For every parameter found, the corresponding</span> </pre></li>
<li><pre><a name="41"></a><span class="comment">-- callback function is called. If at the end of the parsing there are some</span> </pre></li>
<li><pre><a name="42"></a><span class="comment">-- optional parameters that were missing from the command line, the</span> </pre></li>
<li><pre><a name="43"></a><span class="comment">-- corresponding callbacks are called with the default parameter.</span> </pre></li>
<li><pre><a name="44"></a><span class="comment">-- &lt;/summary&gt;</span> </pre></li>
<li><pre><a name="45"></a><span class="keyword">with</span> Ada.Strings.Unbounded; </pre></li>
<li><pre><a name="46"></a><span class="keyword">with</span> Ada.Text_IO; </pre></li>
<li><pre><a name="47"></a> </pre></li>
<li><pre><a name="48"></a><span class="keyword">generic</span> </pre></li>
<li><pre><a name="49"></a> <span class="keyword">type</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:49:9" title="defined at generic_line_parser.ads:49:9">Config_Data</a> <span class="keyword">is</span> <span class="keyword">limited</span> <span class="keyword">private</span>; </pre></li>
<li><pre><a name="50"></a> <span class="comment">-- The parameters read from the command line will be written in</span> </pre></li>
<li><pre><a name="51"></a> <span class="comment">-- a variable of this type</span> </pre></li>
<li><pre><a name="52"></a> </pre></li>
<li><pre><a name="53"></a> <span class="comment">-- Set this to False if you want case insensitive option matching.</span> </pre></li>
<li><pre><a name="54"></a> <span class="comment">-- For example, if you set this to False, "input", "Input", "INPUT"</span> </pre></li>
<li><pre><a name="55"></a> <span class="comment">-- and "InPuT" will be equivalent names for the option "input"</span> </pre></li>
<li><pre><a name="56"></a> <a href="generic_line_parser.ads.html#generic_line_parser.ads:56:4" title="defined at generic_line_parser.ads:56:4">Case_Sensitive</a> : Boolean := True; </pre></li>
<li><pre><a name="57"></a><span class="keyword">package</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:57:9" title="defined at generic_line_parser.ads:57:9">Generic_Line_Parser</a> <span class="keyword">is</span> </pre></li>
<li><pre><a name="58"></a> <span class="keyword">use</span> Ada.Strings.Unbounded; </pre></li>
<li><pre><a name="59"></a> </pre></li>
<li><pre><a name="60"></a> <span class="keyword">type</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:60:9" title="defined at generic_line_parser.ads:60:9">Parameter_Callback</a> <span class="keyword">is</span> </pre></li>
<li><pre><a name="61"></a> <span class="keyword">access</span> <span class="keyword">procedure</span> (<span class="name">Name</span> : <span class="keyword">in</span> Unbounded_String; </pre></li>
<li><pre><a name="62"></a> <span class="name">Value</span> : <span class="keyword">in</span> Unbounded_String; </pre></li>
<li><pre><a name="63"></a> <span class="name">Result</span> : <span class="keyword">in</span> <span class="keyword">out</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:49:9" title="defined at generic_line_parser.ads:49:9">Config_Data</a>); </pre></li>
<li><pre><a name="64"></a> </pre></li>
<li><pre><a name="65"></a> <span class="keyword">type</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:65:9" title="defined at generic_line_parser.ads:65:9">Parameter_Descriptor</a> <span class="keyword">is</span> </pre></li>
<li><pre><a name="66"></a> <span class="keyword">record</span> </pre></li>
<li><pre><a name="67"></a> <span class="name">Name</span> : Unbounded_String; <span class="comment">-- Parameter name</span> </pre></li>
<li><pre><a name="68"></a> <span class="name">Default</span> : Unbounded_String; <span class="comment">-- Default value used if not on C.L.</span> </pre></li>
<li><pre><a name="69"></a> <span class="name">Mandatory</span> : Boolean; <span class="comment">-- Parameter MUST be given</span> </pre></li>
<li><pre><a name="70"></a> <span class="name">Only_Once</span> : Boolean; <span class="comment">-- Parameter MUST NOT be given more than once</span> </pre></li>
<li><pre><a name="71"></a> <span class="name">Callback</span> : <a href="generic_line_parser.ads.html#generic_line_parser.ads:60:9" title="defined at generic_line_parser.ads:60:9">Parameter_Callback</a>; <span class="comment">-- Called when parameter found</span> </pre></li>
<li><pre><a name="72"></a> <span class="keyword">end</span> <span class="keyword">record</span>; </pre></li>
<li><pre><a name="73"></a> <span class="comment">-- &lt;description&gt;Record holding the description of a parameter. The fields</span> </pre></li>
<li><pre><a name="74"></a> <span class="comment">-- should be self-explenatory (I hope). The only field that needs some</span> </pre></li>
<li><pre><a name="75"></a> <span class="comment">-- explanation is Name since it allows to specify more than one</span> </pre></li>
<li><pre><a name="76"></a> <span class="comment">-- name for each parameter. The syntax is very simple: just separate</span> </pre></li>
<li><pre><a name="77"></a> <span class="comment">-- the names with commas. For example, if Name is "f,filename,input"</span> </pre></li>
<li><pre><a name="78"></a> <span class="comment">-- one can use on the command line, with the same effect f=/tmp/a.txt or</span> </pre></li>
<li><pre><a name="79"></a> <span class="comment">-- filename=/tmp/a.txt or input=/tmp/a.txt. Spaces at both ends of</span> </pre></li>
<li><pre><a name="80"></a> <span class="comment">-- the label name are trimmed, so that, for example, "f,filename,input"</span> </pre></li>
<li><pre><a name="81"></a> <span class="comment">-- is equivalent to "f , filename ,input "</span> </pre></li>
<li><pre><a name="82"></a> <span class="comment">-- &lt;/description&gt;</span> </pre></li>
<li><pre><a name="83"></a> </pre></li>
<li><pre><a name="84"></a> </pre></li>
<li><pre><a name="85"></a> <span class="keyword">type</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:85:9" title="defined at generic_line_parser.ads:85:9">Parameter_Descriptor_Array</a> <span class="keyword">is</span> </pre></li>
<li><pre><a name="86"></a> <span class="keyword">array</span> (Natural <span class="keyword">range</span> &lt;&gt;) <span class="keyword">of</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:65:9" title="defined at generic_line_parser.ads:65:9">Parameter_Descriptor</a>; </pre></li>
<li><pre><a name="87"></a> </pre></li>
<li><pre><a name="88"></a> <span class="comment">-- Main exported method. It parses the command line and it writes</span> </pre></li>
<li><pre><a name="89"></a> <span class="comment">-- the result in Result. If some error is encountered, Bad_Command</span> </pre></li>
<li><pre><a name="90"></a> <span class="comment">-- is raised with an explicative exception message. Help_Line,</span> </pre></li>
<li><pre><a name="91"></a> <span class="comment">-- if not empty, is written to Help_Output in case of error.</span> </pre></li>
<li><pre><a name="92"></a> <span class="keyword">procedure</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:92:14" title="defined at generic_line_parser.ads:92:14">Parse_Command_Line</a> </pre></li>
<li><pre><a name="93"></a> (<a href="generic_line_parser.ads.html#generic_line_parser.ads:93:7" title="defined at generic_line_parser.ads:93:7">Parameters</a> : <span class="keyword">in</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:85:9" title="defined at generic_line_parser.ads:85:9">Parameter_Descriptor_Array</a>; </pre></li>
<li><pre><a name="94"></a> <a href="generic_line_parser.ads.html#generic_line_parser.ads:94:7" title="defined at generic_line_parser.ads:94:7">Result</a> : <span class="keyword">out</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:49:9" title="defined at generic_line_parser.ads:49:9">Config_Data</a>; </pre></li>
<li><pre><a name="95"></a> <a href="generic_line_parser.ads.html#generic_line_parser.ads:95:7" title="defined at generic_line_parser.ads:95:7">Help_Line</a> : <span class="keyword">in</span> String := <span class="string">""</span>; </pre></li>
<li><pre><a name="96"></a> <a href="generic_line_parser.ads.html#generic_line_parser.ads:96:7" title="defined at generic_line_parser.ads:96:7">Help_Output</a> : <span class="keyword">in</span> Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Error); </pre></li>
<li><pre><a name="97"></a> </pre></li>
<li><pre><a name="98"></a> <a href="generic_line_parser.ads.html#generic_line_parser.ads:98:4" title="defined at generic_line_parser.ads:98:4">Bad_Command</a> : <span class="keyword">exception</span>; </pre></li>
<li><pre><a name="99"></a> </pre></li>
<li><pre><a name="100"></a> </pre></li>
<li><pre><a name="101"></a> <span class="comment">-- Convenient conversion function to Float that raise Bad_Command if</span> </pre></li>
<li><pre><a name="102"></a> <span class="comment">-- the argument has not a valid syntax</span> </pre></li>
<li><pre><a name="103"></a> <span class="keyword">function</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:103:13" title="defined at generic_line_parser.ads:103:13">To_Float</a> (<a href="generic_line_parser.ads.html#generic_line_parser.ads:103:23" title="defined at generic_line_parser.ads:103:23">X</a> : Unbounded_String) </pre></li>
<li><pre><a name="104"></a> <span class="keyword">return</span> Float; </pre></li>
<li><pre><a name="105"></a> </pre></li>
<li><pre><a name="106"></a> <span class="comment">-- Convenient conversion function to Float that raise Bad_Command if</span> </pre></li>
<li><pre><a name="107"></a> <span class="comment">-- the argument has not a valid syntax</span> </pre></li>
<li><pre><a name="108"></a> <span class="keyword">function</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:108:13" title="defined at generic_line_parser.ads:108:13">To_Natural</a> (<a href="generic_line_parser.ads.html#generic_line_parser.ads:108:25" title="defined at generic_line_parser.ads:108:25">X</a> : Unbounded_String) </pre></li>
<li><pre><a name="109"></a> <span class="keyword">return</span> Natural; </pre></li>
<li><pre><a name="110"></a> </pre></li>
<li><pre><a name="111"></a><span class="keyword">end</span> <a href="generic_line_parser.ads.html#generic_line_parser.ads:57:9" title="defined at generic_line_parser.ads:57:9">Generic_Line_Parser</a>; </pre></li>
</ol></div>
</div>
</body>
</html>

408
lib/gclp/doc/support/docgen.css
Unescape View File

@ -0,0 +1,408 @@
body
{
background: #F4F4F4;
font-family: arial, verdana;
font-size: 90%;
margin: 0px 0px 10px 205px;
height: 100%;
}
h1,
h2
{
padding: 0px 0px 0px 5px;
margin: 0px;
font-variant: small-caps;
font-size: 1.1em;
}
h3,
h4
{
font-size: 1.0em;
}
a:link,
a:active,
a:visited
{
text-decoration: none;
color: blue;
}
a:hover
{
color: red;
}
a.hide:link,
a.hide:active,
a.hide:hover,
a.hide:visited
{
color: black;
margin-right: 5px;
}
pre
{
margin: 0px;
}
div.topBar
{
position: fixed;
top: 0px;
left: 0px;
margin: 0px;
margin-left: 193px;
width: 100%;
padding-bottom: 10px;
z-index: 1;
background: transparent url(../support/images/menubarbottom.png) repeat-x bottom;
}
div.topBarInside
{
padding-top: 10px;
padding-bottom: 5px;
width: 100%;
background: transparent url(../support/images/menubar.png) repeat-x top;
}
div.topBarLinks
{
z-index: 1;
padding: 0px;
margin-top: 0px;
margin-right: 20px;
margin-left: 10px;
text-align: left;
}
/* Generate page layout */
div#leftSide
{
position: fixed;
top: 0px;
left: 0px;
width: 205px;
margin: 0px;
padding: 0px;
padding-bottom: 31px;
background: transparent url(../support/images/sidebarframebottom.png) no-repeat bottom;
z-index: 20;
font-size: 0.9em;
}
div#leftSide div#leftSideInside
{
width: 205px;
padding-top: 5px;
margin: 0px;
border: 0px;
background: url(../support/images/sidebarframe.png) no-repeat;
}
div#leftSideInside div
{
padding-top: 10px;
margin-top: 0px;
}
div#leftSideInside .button
{
position: relative;
width: 185px;
background: transparent url(../support/images/nav1_btn_up.png) no-repeat right;
height: 27px;
padding: 3px 0px 0px 5px;
z-index: 10;
}
div#leftSideInside a .button
{
color: #2020A0;
}
div#leftSideInside a:hover .button
{
color: #A02020;
background: transparent url(../support/images/nav1_btn_mo.png) no-repeat right;
}
div#leftSideInside a
{
position: relative;
z-index: 1;
}
div#leftSideInside i .button2,
div#leftSideInside a .button2
{
position: relative;
margin: -6px 0px 0px 0px;
height: 26px;
width: 183px;
padding: 5px 0px 0px 5px;
background: transparent url(../support/images/nav2_btn_up.png) no-repeat right 0px;
list-style-type: none;
list-style-position: inside;
z-index: 1;
}
div#leftSideInside i .button2
{
color: #802020;
}
div#leftSideInside a .button2
{
color: #2020A0;
}
div#leftSideInside a:hover .button2
{
color: #A02020;
background: transparent url(../support/images/nav2_btn_mo.png) no-repeat right 0px;
}
#rightSide
{
float: right;
width: 205px;
margin: 0px 0px 0px 0px;
padding: 0px;
padding-bottom: 31px;
background: transparent url(../support/images/rightsidebottom.png) no-repeat bottom;
font-size: 0.8em;
}
div#rightSide div#rightSideInside
{
width: 205px;
padding-top: 10px;
padding-left: 12px;
margin: 0px;
border: 0px;
background: url(../support/images/rightside.png) repeat;
}
div#Index ul
{
margin: 2px 0px 0px 0px;
padding: 0px 0px 0px 0px;
}
div#Index li
{
width: 193px;
list-style-type: none;
list-style-position: outside;
border-top: 1px dotted #c0c0c0;
}
div#Index li a
{
color: #2020A0;
padding-left: 20px;
}
div#Index li a:hover
{
color: #E04040;
}
div#Index li.package-spec a
{
background: transparent url(../support/images/package-spec.png) no-repeat 3px 0px;
}
div#Index li.task-spec,
div#Index li.protected-spec,
div#Index li.var-spec
{
background: transparent url(../support/images/variable-spec.png) no-repeat 3px 0px;
}
div#Index li.class-spec,
div#Index li.task-type-spec,
div#Index li.protected-type-spec,
div#Index li.type-spec
{
background: transparent url(../support/images/type-spec.png) no-repeat 3px 0px;
}
div#Index li.subp-spec
{
background: transparent url(../support/images/subprogram-spec.png) no-repeat 3px 0px;
}
/* Styles within each region */
#documentation
{
margin: 0px 0px 0px 0px;
padding: 0px 210px 10px 0px;
}
div.title,
div.titleTopBar
{
text-align: center;
padding: 0px 0px 0px 5px;
font-weight: bold;
font-variant: small-caps;
font-size: 1.1em;
}
div.title
{
padding-top: 10px;
}
div.titleTopBar
{
margin-top: 100px;
}
div.subprograms
{
font-size: 90%;
margin: 10px 0px 0px 0px;
}
div.subprograms .class
{
border: 1px solid #c0c0c0;
margin-top: 5px;
padding: 0px;
}
div.subprograms .name
{
color: red;
}
div.subprograms h3
{
background: #dae3fe;
padding: 0px 0px 0px 5px;
margin: 0px 0px 0px 0px;
}
div.subprograms h4
{
padding: 0px;
margin: 0px;
}
div.subprograms div.profile
{
font-family: courier new, courier;
padding: 5px 5px 5px 5px;
background: white;
}
div.subprograms div.details
{
font-family: courier new, courier;
padding-top: 0px;
padding-left: 5px;
padding-top: 3px;
padding-bottom: 3px;
background: #fafaff;
}
div.subprograms div.details div
{
padding-left: 0px;
}
div.subprograms div.details table
{
padding-left: 20px;
}
div.subprograms div.details span.keyword
{
font-weight: bold;
color: #970505;
}
div.subprograms div.details span.string
{
font-style: italic;
color: #0A9988;
}
div.subprograms div.details span.comment
{
color: #209020;
}
div.subprograms div.comment
{
border-top: 1px dotted #c0c0c0;
background: white;
padding-left: 5px;
padding-top: 0px;
padding-bottom: 0px;
}
div.subprograms div.comment *
{
margin: 0px;
padding-top: 3px;
padding-bottom: 3px;
}
div.subprograms .type,
div.subprograms .type * { padding-left: 0px;
font-weight: normal; }
div.subprograms div.entries
{
padding: 0px;
border: 1px solid #c0c0c0;
}
div.subprograms div.parameters,
div.subprograms div.parameters
{
font-family: courier new, courier;
background: #eee;
}
div.subprograms div.parameters div,
div.subprograms div.details div { padding: 0px 0px 0px 0px;
margin: 0px 0px 0px 0px;
border: 0px;}
div.entity
{
font-size: 0.9em;
margin-left: 20px;
}
div.classroot,
div.classtree
{
position: relative;
margin: 0px 0px 0px 0px;
padding: 0px 0px 0px 0px;
}
div.classroot
{
background: transparent url(../support/images/tree_root.png) no-repeat left 0px;
margin-bottom: 3px;
}
div.classtree
{
background: transparent url(../support/images/tree_item.png) no-repeat left 0px;
}
div.classtreechildren
{
position: relative;
top: -4px;
margin: 0px 0px 0px 8px;
padding: 0px 0px 7px 0px;
background: transparent url(../support/images/treechildren_bg_bottom.png) no-repeat left bottom;
}
div.classtreechildreninside
{
margin: 0px 0px 0px 0px;
padding: 0px 0px 5px 8px;
background: transparent url(../support/images/treechildren_bg.png) repeat-y left;
}
div.classroot h3,
div.classtree h3
{
position: relative;
height: 30px;
font-weight: normal;
padding: 4px 0px 0px 15px;
margin: 0px 0px -6px 0px;
z-index: 5;
}
/* For printing we do not want the table of contents nor the index */
@media print {
body { margin: 10px; }
#rightSide { display: none; }
#leftSide { display: none; }
#documentation { margin: 10px; }
}

226
lib/gclp/doc/support/docgen.js
Unescape View File

@ -0,0 +1,226 @@
myGetAttribute = function (elt, attribute) {
if (attribute == "class") attribute = "className";
return elt[attribute];
}
mySetAttribute = function (elt, attribute, value) {
if (attribute == "class") attribute = "className";
elt[attribute] = value;
}
function setHidingLinks() {
onloadDoc();
}
function onloadDoc() {
if (!document.getElementsByTagName) { return; }
if (!document.getElementById) { return; }
var main = document.getElementById ('leftSideInside');
var link1, link2;
setLinksForTag ('h2', '');
link1 = setLinksForTag ('h3', '');
link2 = setLinksForTag ('h4', 'hidden');
if (link1 | link2) {
div=document.createElement('div');
main.appendChild (div);
div=document.createElement('div');
div.setAttribute ('class', 'button');
div.setAttribute ('className', 'button'); /* for Internet Explorer */
text=document.createTextNode('Unfold');
div.appendChild (text);
lnk=document.createElement ("a");
lnk.setAttribute ('href', '#');
lnk.onclick = function () {showAllTags ('h3'); return false;}
lnk.appendChild (div);
main.appendChild (lnk);
var h4s = document.getElementsByTagName ('h4');
if (h4s.length > 0) {
div=document.createElement('div');
div.setAttribute ('class', 'button');
div.setAttribute ('className', 'button'); /* for Internet Explorer */
text=document.createTextNode('Unfold all');
div.appendChild (text);
lnk=document.createElement ("a");
lnk.setAttribute ('href', '#');
lnk.onclick = function () {showAllTags ('h3'); showAllTags ('h4'); return false;}
lnk.appendChild (div);
main.appendChild (lnk);
}
div=document.createElement('div');
div.setAttribute ('class', 'button');
div.setAttribute ('className', 'button'); /* for Internet Explorer */
text=document.createTextNode('Fold all');
div.appendChild (text);
lnk=document.createElement ("a");
lnk.setAttribute ('href', '#');
lnk.onclick = function () {hideAllTags ('h4'); hideAllTags ('h3'); return false;}
lnk.appendChild (div);
main.appendChild (lnk);
}
tags=document.getElementsByTagName('a');
for (var j=0; j<tags.length; j++) {
var href=tags[j].getAttribute ('href');
if (href == null) continue;
if ((href != '#') && (href.indexOf('#') > -1)) {
tags[j].onclick = function() {showLocationFromA(this); return true}
}
}
// Should open a referenced entity
ref = document.location.hash;
if (ref != '') {
if (ref.indexOf('#') > -1) {
ref = ref.substr (1);
showLocation (ref);
elem = document.getElementById (ref);
if (elem) window.scrollTo (0,elem.offsetTop);
}
}
}
function sortElem(a,b)
{
return a[0].toLowerCase() > b[0].toLowerCase() ? 1 : -1;
}
function printIndexList (names) {
if (names.length > 1) {
names.sort (sortElem);
document.write ('<ul>');
for (var j = 0; j < names.length; j++) {
if (names[j][0] != 'dummy') {
document.write ('<li class="'+names[j][2]+'"><a href="#'+names[j][1]+'" onclick="showLocation(\''+names[j][1]+'\')">'+names[j][0]+'</a></li>');
}
}
document.write ('</ul>');
}
}
function setLinksForTag (tag, defaultstate) {
var titles = document.getElementsByTagName (tag);
for (var i=0; i<titles.length; i++){
if (canToggle (titles[i])) {
// insert <a href="#" onclick="return hide(this)">&#9660;</a>
text=document.createTextNode('▼');
lnk=document.createElement("a");
lnk.setAttribute ('href', '#');
lnk.setAttribute ('class', 'hide');
lnk.setAttribute ('className', 'hide'); /* for Internet Explorer */
lnk.appendChild(text);
lnk.onclick = function () {toggle(this); return false;}
titles[i].insertBefore (lnk, titles[i].firstChild);
if (defaultstate == 'hidden')
toggle (lnk);
}
}
return titles.length > 0;
}
function showLocationFromA (tag) {
var href = tag.getAttribute('href');
url = href.substr (0, href.indexOf('#'));
while (url.indexOf('/') > -1) url = url.substr (url.indexOf('/') + 1);
myurl = document.location.pathname;
while (myurl.indexOf('/') > -1) myurl = myurl.substr (myurl.indexOf('/') + 1);
if ((url != myurl) && (url != '')) return true;
href = href.substr (href.indexOf('#') + 1);
showLocation (href);
}
function showLocation (loc) {
var links = document.getElementsByTagName('a');
for (var j=0; j < links.length; j++) {
if (links[j].getAttribute ('name') == loc) {
var parent = links[j].parentNode;
while (parent != document) {
var elem = parent.firstChild;
if (elem.firstChild != null)
if (elem.firstChild.nodeValue == '►')
toggle (elem);
if (parent.tagName.toLowerCase() == 'div') {
for (var k=0; k < parent.childNodes.length; k++) {
if (parent.childNodes[k].nodeType == 1 &&
parent.childNodes[k].firstChild != null &&
parent.childNodes[k].firstChild.nodeType == 1 &&
parent.childNodes[k].firstChild.tagName.toLowerCase() == 'a') {
elem = parent.childNodes[k].firstChild;
if (elem.firstChild != null)
if (elem.firstChild.nodeValue == '►')
toggle (elem);
}
}
}
parent = parent.parentNode;
}
return;
}
}
return;
}
function hideAllTags (tag) {
if (!document.getElementsByTagName) { return; }
var titles = document.getElementsByTagName (tag);
for (var i=0; i<titles.length; i++){
if (titles[i].firstChild.firstChild.nodeValue == '▼') {
toggle (titles[i].firstChild);
}
}
}
function showAllTags (tag) {
if (!document.getElementsByTagName) { return; }
var titles = document.getElementsByTagName (tag);
for (var i=0; i<titles.length; i++){
if (titles[i].firstChild.firstChild.nodeValue == '►') {
toggle (titles[i].firstChild);
}
}
}
function canToggle (elem) {
var children = elem.parentNode.childNodes;
for (var j = 0; j < children.length; j++) {
var el = children[j];
if (el.nodeType == 1 &&
el.tagName.toLowerCase() != 'script' &&
el.tagName.toLowerCase() != 'h2' &&
el.tagName.toLowerCase() != 'h3' &&
el.tagName.toLowerCase() != 'h4') {
return true;
}
}
return false;
}
function toggle (elem) {
var children = elem.parentNode.parentNode.childNodes;
var next_display;
if (elem.childNodes[0].nodeValue == '▼') {
next_display = 'none';
elem.childNodes[0].nodeValue = '►';
} else {
next_display = 'block';
elem.childNodes[0].nodeValue = '▼';
}
for (var j = 0; j < children.length; j++) {
var el = children[j];
if (el.nodeType == 1 &&
el.tagName.toLowerCase() != 'script' &&
el.tagName.toLowerCase() != 'h2' &&
el.tagName.toLowerCase() != 'h3' &&
el.tagName.toLowerCase() != 'h4') {
el.style.display = next_display;
}
}
return false;
}

BIN
lib/gclp/doc/support/images/arrow_close.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1002 B

BIN
lib/gclp/doc/support/images/arrow_open.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.8 KiB

BIN
lib/gclp/doc/support/images/generic-spec.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 423 B

BIN
lib/gclp/doc/support/images/menubar.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 227 B

BIN
lib/gclp/doc/support/images/menubarbottom.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 167 B

BIN
lib/gclp/doc/support/images/nav1_btn_mo.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.3 KiB

BIN
lib/gclp/doc/support/images/nav1_btn_up.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.0 KiB

BIN
lib/gclp/doc/support/images/nav2_btn_mo.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.2 KiB

BIN
lib/gclp/doc/support/images/nav2_btn_up.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.1 KiB

BIN
lib/gclp/doc/support/images/package-spec.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 426 B

BIN
lib/gclp/doc/support/images/rightside.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.8 KiB

BIN
lib/gclp/doc/support/images/rightsidebottom.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
lib/gclp/doc/support/images/sidebarframe.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 11 KiB

BIN
lib/gclp/doc/support/images/sidebarframebottom.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.2 KiB

BIN
lib/gclp/doc/support/images/subprogram-spec.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 532 B

BIN
lib/gclp/doc/support/images/tree_item.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.8 KiB

BIN
lib/gclp/doc/support/images/tree_root.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.7 KiB

BIN
lib/gclp/doc/support/images/treechildren_bg.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 197 B

BIN
lib/gclp/doc/support/images/treechildren_bg_bottom.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 301 B

BIN
lib/gclp/doc/support/images/type-spec.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 483 B

BIN
lib/gclp/doc/support/images/variable-spec.png
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 407 B

43
lib/gclp/doc/tags.css
Unescape View File

@ -0,0 +1,43 @@
div.summary:before
{
content: "Summary: ";
font-weight: bold;
}
div.summary
{
border-bottom: 1px dotted #e0e0e0;
}
div.description:before
{
content: "Description: ";
font-weight: bold;
}
div.description
{
font-style: italic;
border-bottom: 1px dotted #e0e0e0;
}
div.parameter *
{
font-style: italic;
color: #444;
display: inline;
}
div.exception:before
{
content: "Exception: ";
font-weight: bold;
}
div.seealso:before
{
content: "See also: ";
font-weight: bold;
}
div.seealso
{
font-style: italic;
}

30
lib/gclp/doc/tree.html
Unescape View File

@ -0,0 +1,30 @@
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html><head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
<meta http-equiv="Content-Script-Type" content="text/javascript"/>
<title>
Global Class Inheritance Trees
</title>
<link rel='stylesheet' href='support/docgen.css' type='text/css'/>
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
<div id='leftSide'>
<div id='leftSideInside'>
<div id='header'>
<h2 class="button">Documentation</h2>
<a href='index.html'><div class="button2">Table of Contents</div></a>
<i><div class="button2">Class Inheritance Tree</div></i>
</div>
</div>
</div>
<div class='title'>
Global Class Inheritance Trees
</div>
</body>
</html>

70
lib/gclp/examples/Basic_Example/README.txt
Unescape View File

@ -0,0 +1,70 @@
This directory contains a very basic example of usage of the generic
package.
Our goal
========
We want to write the line parsing code for a program that is supposed
to contact a remote host, authenticating with a username and,
possibly, a password. By default the remote host listens on port
4242, but a different port can be specified. The main procedure in
basic_example-main.adb implements the required command line parsing
and prints the result on the standard output.
More precisely, the parameters on the command line are to be specified
as follows
* The host address will be specified with the parameter "host" (only
numerical addresses are accepted)
* The optional port will be specified with the parameter "port", if
not specified, the port defaults to 4242
* The username can be specified, equivalently, with the parameter
"user" or with the parameter "username"
* The optional password can be specified, equivalently, with the parameter
"pwd" or with the parameter "password". If not specified, the
password defaults to ""
Examples
--------
Therefore, for example, the following command lines are accepted
basic_example-main host=196.18.1.34 user=pippo
Contact host 196.18.1.34 on port 4242 with username pippo and no password
basic_example-main host=196.18.1.34 username=pippo
Equivalent to the command line above
basic_example-main host=196.18.1.34 user=pippo pwd=pluto
Contact host 196.18.1.34 with username pippo and password pluto
basic_example-main host=196.18.1.34 user=pippo password=pluto
Equivalent to the command line above
basic_example-main host=196.18.1.34 port=12345 user=pippo
Contact host 196.18.1.34 on port 12345 with username pippo and no password
Structure of the program
========================
It is very simple:
* basic_example-main.adb
Contains the main procedure
* basic_example-parameters.adb
Defines a record that holds the four parameters (host, port,
username and password) that can be specified by the user. It
defines also procedures that set the four parameters and that
can be used as callbacks for the line parsers.

74
lib/gclp/examples/Basic_Example/basic_example-main.adb
Unescape View File

@ -0,0 +1,74 @@
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with GNAT.Sockets;
with Generic_Line_Parser;
with Basic_Example.Parameters; -- Defines the record with the user parameters
procedure Basic_Example.Main is
use Ada.Strings;
use Ada.Strings.Unbounded;
use GNAT;
-- Convenient shorthand for the function that converts strings to
-- unbounded strings
function To_U (X : String) return Unbounded.Unbounded_String
renames Unbounded.To_Unbounded_String;
-- Instantiate a specific version of Generic_Line_Parser suited
-- for the User_Parameters record defined in Basic_Example.Parameters
package Line_Parser is
new Generic_Line_Parser (Parameters.User_Parameters);
-- Declare the array of parameter descriptors. Note that the
-- callbacks are set to the procedures declared in
-- Basic_Example.Parameters
Descriptors : Line_Parser.Parameter_Descriptor_Array :=
((Name => To_U ("host"),
Default => <>,
Mandatory => True,
Only_Once => True,
Callback => Parameters.Set_Host'Access),
(Name => To_U ("port"),
Default => To_U ("4242"),
Mandatory => False,
Only_Once => True,
Callback => Parameters.Set_Port'Access),
-- Both "user" and "username" are acceptable
(Name => To_U ("user,username"),
Default => <>,
Mandatory => True,
Only_Once => True,
Callback => Parameters.Set_Username'Access),
-- Both "pwd" and "password" are acceptable
(Name => To_U ("pwd,password"),
Default => Unbounded.Null_Unbounded_String,
Mandatory => False,
Only_Once => True,
Callback => Parameters.Set_Password'Access));
Param : Parameters.User_Parameters;
begin
Line_Parser.Parse_Command_Line
(Parameters => Descriptors,
Result => Param);
Ada.Text_IO.Put ("I am going to contact host '"
& Sockets.Image (Param.Host)
& "' on port "
& Sockets.Port_Type'Image (Param.Port)
& " with username '"
& Unbounded.To_String (Param.Username)
& "'");
if Param.Password = Unbounded.Null_Unbounded_String then
Ada.Text_IO.Put_Line (" and no password");
else
Ada.Text_IO.Put_Line (" and password '"
& Unbounded.To_String (Param.Password)
& "'");
end if;
end Basic_Example.Main;

58
lib/gclp/examples/Basic_Example/basic_example-parameters.adb
Unescape View File

@ -0,0 +1,58 @@
package body Basic_Example.Parameters is
use GNAT;
use Ada.Strings;
--------------
-- Set_Host --
--------------
procedure Set_Host
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters)
is
begin
Result.Host := Sockets.Inet_Addr (Unbounded.To_String (Value));
end Set_Host;
--------------
-- Set_Port --
--------------
procedure Set_Port
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters)
is
begin
Result.Port := Sockets.Port_Type'Value (Unbounded.To_String (Value));
end Set_Port;
------------------
-- Set_Username --
------------------
procedure Set_Username
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters)
is
begin
Result.Username := Value;
end Set_Username;
------------------
-- Set_Password --
------------------
procedure Set_Password
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters)
is
begin
Result.Password := Value;
end Set_Password;
end Basic_Example.Parameters;

38
lib/gclp/examples/Basic_Example/basic_example-parameters.ads
Unescape View File

@ -0,0 +1,38 @@
with GNAT.Sockets;
with Ada.Strings.Unbounded;
package Basic_Example.Parameters is
use GNAT;
use Ada.Strings.Unbounded;
type User_Parameters is
record
Host : Sockets.Inet_Addr_Type;
Port : Sockets.Port_Type;
Username : Unbounded_String;
Password : Unbounded_String;
end record;
-- Record that holds the paramters that can be specified by the user.
-- The following four procedures can be used as callbacks in an
-- instantiation of Generic_Line_Parser.
procedure Set_Host
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Port
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Username
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Password
(Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out User_Parameters);
end Basic_Example.Parameters;

6
lib/gclp/examples/Basic_Example/basic_example.ads
Unescape View File

@ -0,0 +1,6 @@
package Basic_Example is
-- Root
end Basic_Example;

14
lib/gclp/examples/gclp_examples.gpr
Unescape View File

@ -0,0 +1,14 @@
project Gclp_examples is
for Object_Dir use "bin";
for Source_Dirs use ("..", ".", "Basic_Example");
for Main use ("basic_example-main.adb");
package Compiler is
for Default_Switches ("ada") use ("-gnat05", "-gnata", "-g");
end Compiler;
end Gclp_examples;

11
lib/gclp/gclp.gpr
Unescape View File

@ -0,0 +1,11 @@
project Gclp is
for Object_Dir use "bin";
package Compiler is
-- for Default_Switches ("ada") use ("-gnat05", "-gnata", "-g");
for Default_Switches ("ada") use ("-gnata", "-g");
end Compiler;
end Gclp;

359
lib/gclp/generic_line_parser.adb
Unescape View File

@ -0,0 +1,359 @@
----------------------------------------------------------------------------
-- Generic Command Line Parser (gclp)
--
-- Copyright (C) 2012, Riccardo Bernardini
--
-- This file is part of gclp.
--
-- gclp 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.
--
-- gclp 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 gclp. If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------
--
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Containers.Ordered_Maps;
with Ada.Strings.Maps.Constants;
with Ada.Containers.Doubly_Linked_Lists;
use Ada;
use Ada.Strings;
use Ada.Strings.Fixed;
package body Generic_Line_Parser is
function To_S (X : Unbounded_String) return String
renames To_String;
function To_U (X : String) return Unbounded_String
renames To_Unbounded_String;
-- In order to handle parameter aliases (see comments in the specs)
-- we keep a table that maps parameter names to parameter "index"
package Name_To_Index_Maps is
new Ada.Containers.Ordered_Maps (Key_Type => Unbounded_String,
Element_Type => Natural);
--------------------
-- Case_Normalize --
--------------------
-- If the user required case insensitive matching, force the
-- name to lower case
procedure Case_Normalize (Name : in out Unbounded_String) is
begin
if not Case_Sensitive then
Translate (Name, Maps.Constants.Lower_Case_Map);
end if;
end Case_Normalize;
---------------------
-- Fill_Name_Table --
---------------------
-- Fill the Parameter Name -> parameter index table with the
-- parameter names
procedure Fill_Name_Table (Parameters : in Parameter_Descriptor_Array;
Name_Table : in out Name_To_Index_Maps.Map)
is
package Name_Lists is
new Ada.Containers.Doubly_Linked_Lists (Unbounded_String);
use Name_Lists;
----------------
-- Parse_Name --
----------------
function Parse_Name (Name : Unbounded_String) return Name_Lists.List
is
------------------
-- Trimmed_Name --
------------------
function Trimmed_Name (Name : String)
return Unbounded_String
is
Trimmed : Unbounded_String;
begin
Trimmed := To_U (Fixed.Trim (Name, Both));
if Unbounded.Length (Trimmed) = 0 then
raise Constraint_Error
with "Empty alternative in label '" & Name & "'";
else
return Trimmed;
end if;
end Trimmed_Name;
Result : Name_Lists.List;
Buffer : String := To_S (Name);
First : Natural;
Comma_Pos : Natural;
begin
if Fixed.Index (Buffer, "=") /= 0 then
raise Constraint_Error with "Option label '" & Buffer & "' has '='";
end if;
if Buffer(Buffer'Last) = ',' then
raise Constraint_Error
with "Option label '" & Buffer & "' ends with ','";
end if;
First := Buffer'First;
loop
pragma Assert (First <= Buffer'Last);
Comma_Pos := Fixed.Index (Buffer (First .. Buffer'Last), ",");
exit when Comma_Pos = 0;
if First = Comma_Pos then
-- First should always point to the beginning of a
-- label, therefore it cannot be Buffer(First) = ','
raise Constraint_Error
with "Wrong syntax in Option label '" & Buffer & "'";
end if;
pragma Assert (Comma_Pos > First);
Result.Append (Trimmed_Name (Buffer(First .. Comma_Pos - 1)));
First := Comma_Pos + 1;
-- It cannot be First > Buffer'Last since Buffer(Comma_Pos) = '='
-- and Buffer(Buffer'Last) /= ','
pragma Assert (First <= Buffer'Last);
end loop;
pragma Assert (First <= Buffer'Last);
Result.Append (Trimmed_Name (Buffer (First .. Buffer'Last)));
return Result;
end Parse_Name;
Option_Names : Name_Lists.List;
Position : Name_Lists.Cursor;
Name : Unbounded_String;
begin
for Idx in Parameters'Range loop
Option_Names := Parse_Name (Parameters (Idx).Name);
Position := Option_Names.First;
while Position /= No_Element loop
Name := Name_Lists.Element (Position);
Name_Lists.Next (Position);
Case_Normalize(Name);
if Name_Table.Contains (Name) then
raise Constraint_Error
with "Ambiguous label '" & To_S (Name) & "'";
end if;
Name_Table.Insert (Name, Idx);
end loop;
end loop;
end Fill_Name_Table;
----------------
-- To_Natural --
----------------
function To_Natural (X : Unbounded_String)
return Natural is
begin
if X = Null_Unbounded_String then
raise Bad_Command with "Invalid integer '" & To_S(X) & "'";
end if;
return Natural'Value (To_S (X));
end To_Natural;
--------------
-- To_Float --
--------------
function To_Float (X : Unbounded_String)
return Float is
begin
if X = Null_Unbounded_String then
raise Bad_Command with "Invalid Float '" & To_S(X) & "'";
end if;
return Float'Value (To_S (X));
end To_Float;
------------------------
-- Parse_Command_Line --
------------------------
procedure Parse_Command_Line
(Parameters : in Parameter_Descriptor_Array;
Result : out Config_Data;
Help_Line : in String := "";
Help_Output : in Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Error) is
package String_Lists is
new Ada.Containers.Doubly_Linked_Lists (Unbounded_String);
---------------------
-- Split_Parameter --
---------------------
procedure Split_Parameter (Param : in String;
Name : out Unbounded_String;
Value : out Unbounded_String)
is
Idx : Natural;
begin
Idx := Index (Source => Param,
Pattern => "=");
if (Idx = 0) then
Name := To_U (Param);
Value := Null_Unbounded_String;
else
Name := To_U (Param (Param'First .. Idx - 1));
Value := To_U (Param (Idx + 1 .. Param'Last));
end if;
Case_Normalize (Name);
end Split_Parameter;
function Missing_Message (Missing : String_Lists.List)
return String
is
function Join (Item : String_Lists.List) return String is
Result : Unbounded_String;
procedure Append (Pos : String_Lists.Cursor) is
begin
if Result /= Null_Unbounded_String then
Result := Result & ", ";
end if;
Result := Result & "'" & String_Lists.Element (Pos) & "'";
end Append;
begin
Item.Iterate (Append'Access);
return To_String(Result);
end Join;
use type Ada.Containers.Count_Type;
begin
if Missing.Length = 1 then
return "Missing mandatory option " & Join (Missing);
else
return "Missing mandatory options: " & Join (Missing);
end if;
end Missing_Message;
Found : array (Parameters'Range) of Boolean := (others => False);
Name : Unbounded_String;
Value : Unbounded_String;
use Name_To_Index_Maps;
Name_Table : Name_To_Index_Maps.Map;
Position : Name_To_Index_Maps.Cursor;
Param_Idx : Natural;
begin
Fill_Name_Table (Parameters, Name_Table);
for Pos in 1 .. Command_Line.Argument_Count loop
Split_Parameter (Command_Line.Argument (Pos), Name, Value);
Position := Name_Table.Find (Name);
if Position = No_Element then
raise Bad_Command with "Option '" & To_S (Name) & "' unknown";
end if;
Param_Idx := Name_To_Index_Maps.Element (Position);
if Found (Param_Idx) and then Parameters (Param_Idx).Only_Once then
raise Bad_Command with "Option '" & To_S (Name) & "' given twice";
end if;
Found (Param_Idx) := True;
Parameters (Param_Idx).Callback (Name => Name,
Value => Value,
Result => Result);
end loop;
declare
use type Name_To_Index_Maps.Cursor;
Missing : String_Lists.List;
Param_Idx : Natural;
Position : Name_To_Index_Maps.Cursor;
Reported : array (Parameters'Range) of Boolean := (others => False);
-- Reported(Idx) is true if the parameter with index Idx has
-- already processed as missing. We need this since we loop over
-- the option names and more than option can refer to the same
-- parameter.
begin
Position := Name_Table.First;
while Position /= Name_To_Index_Maps.No_Element loop
Param_Idx := Name_To_Index_Maps.Element (Position);
-- Ada.Text_IO.Put ("checking" & To_S(Parameters (Param_Idx).Name) & "->");
-- Ada.Text_IO.Put (Boolean'Image (Found (Param_Idx)));
-- Ada.Text_IO.Put_Line (" "& Boolean'Image (Reported (Param_Idx)));
if not Found (Param_Idx) and not Reported (Param_Idx) then
Reported (Param_Idx) := True;
case Parameters (Param_Idx).If_Missing is
when Die =>
Missing.Append (Name_To_Index_Maps.Key (Position));
when Use_Default =>
Parameters (Param_Idx).Callback
(Name => Parameters (Param_Idx).Name,
Value => Parameters (Param_Idx).Default,
Result => Result);
when Ignore =>
null;
end case;
end if;
Name_To_Index_Maps.Next (Position);
end loop;
if not Missing.Is_Empty then
raise Bad_Command with Missing_Message (Missing);
end if;
end;
exception
when Bad_Command =>
if Help_Line /= "" then
Ada.Text_IO.Put_Line (File => Help_Output,
Item => Help_Line);
end if;
raise;
end Parse_Command_Line;
end Generic_Line_Parser;

149
lib/gclp/generic_line_parser.ads
Unescape View File

@ -0,0 +1,149 @@
----------------------------------------------------------------------------
-- Generic Command Line Parser (gclp)
--
-- Copyright (C) 2012, Riccardo Bernardini
--
-- This file is part of gclp.
--
-- gclp 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.
--
-- gclp 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 gclp. If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------
--
-- <summary>
-- <p>This is a generic package implementing a simple-to-use command line
-- parser. Yes, I know, everyone makes his/her own command line parser...
-- so, I wrote mine. As they say, every open source project starts
-- with a programmer that schratches its own itch. So I did... If
-- you find this useful, you are welcome to use it.</p>
--
-- <p>The ideas behind this package are the following
--
-- <itemize>
-- <item> <p>Parameters are nominal, non positional. The syntax is of
-- "named parameter" type, that is, each command line parameter is
-- expected to have thefollowing format</p>
--
-- <center>label ['=' value]</center>
--
-- <p>where "label" is any string without '='.</p></item>
--
-- <item><p> Parsed value are written in a "configuration variable" whose type
-- is a formal parameter of this package. The values are written
-- in the configuration variable by using some callbacks provided
-- by caller.</p></item>
-- </itemize>
-- </p>
-- The names of the parameters are given to the parser in "parameter
-- description array" that is an array of records that specify
--
-- + The parameter name
--
-- + A default value (if needed)
--
-- + What to do if the parameter is missing
--
-- + If it can be specified more than once
--
-- + The callback function to be called when the parameter is found
--
-- In order to parse the command line it suffices to call Parse_Command_Line
-- giving as argument the array of parameter descriptors and the configuration
-- variable to be written. For every parameter found, the corresponding
-- callback function is called. If at the end of the parsing there are some
-- optional parameters that were missing from the command line, the
-- corresponding callbacks are called with the default parameter.
-- </summary>
with Ada.Strings.Unbounded;
with Ada.Text_IO;
generic
type Config_Data (<>) is limited private;
-- The parameters read from the command line will be written in
-- a variable of this type
Case_Sensitive : Boolean := True;
-- Set this to False if you want case insensitive option matching.
-- For example, if you set this to False, "input", "Input", "INPUT"
-- and "InPuT" will be equivalent names for the option "input"
package Generic_Line_Parser is
use Ada.Strings.Unbounded;
type Parameter_Callback is
access procedure (Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out Config_Data);
type Missing_Action is (Die, Use_Default, Ignore);
-- Possibile alternatives about what to do if a parameter is missing
--
-- [Die] The parameter is mandatory. If it is missing, an
-- exception with explicative message is raised
--
-- [Use_Default] The parameter is optional. If it is missing, the
-- corresponding callback function is called with the
-- specified default value (see record
-- Parameter_Descriptor in the following)
--
-- [Ignore] The parameter is optional. If it is missing, nothing
-- is done
type Parameter_Descriptor is
record
Name : Unbounded_String; -- Parameter name
Default : Unbounded_String; -- Default value used if not on C.L.
If_Missing : Missing_Action; -- What to do if parameter missing
Only_Once : Boolean; -- Parameter MUST NOT be given more than once
Callback : Parameter_Callback; -- Called when parameter found
end record;
-- <description>Record holding the description of a parameter. The fields
-- should be self-explenatory (I hope). The only field that needs some
-- explanation is Name since it allows to specify more than one
-- name for each parameter. The syntax is very simple: just separate
-- the names with commas. For example, if Name is "f,filename,input"
-- one can use on the command line, with the same effect f=/tmp/a.txt or
-- filename=/tmp/a.txt or input=/tmp/a.txt. Spaces at both ends of
-- the label name are trimmed, so that, for example, "f,filename,input"
-- is equivalent to "f , filename ,input "
-- </description>
type Parameter_Descriptor_Array is
array (Natural range <>) of Parameter_Descriptor;
procedure Parse_Command_Line
(Parameters : in Parameter_Descriptor_Array;
Result : out Config_Data;
Help_Line : in String := "";
Help_Output : in Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Error);
-- Main exported method. It parses the command line and it writes
-- the result in Result. If some error is encountered, Bad_Command
-- is raised with an explicative exception message. If Help_Line is
-- not empty, it is written to Help_Output in case of error.
Bad_Command : exception;
function To_Float (X : Unbounded_String)
return Float;
-- Convenient conversion function to Float that raise Bad_Command if
-- the argument has not a valid syntax
function To_Natural (X : Unbounded_String)
return Natural;
-- Convenient conversion function to Float that raise Bad_Command if
-- the argument has not a valid syntax
end Generic_Line_Parser;

110
lib/gclp/test/parsing_test.adb
Unescape View File

@ -0,0 +1,110 @@
----------------------------------------------------------------------------
-- Generic Command Line Parser (gclp)
--
-- Copyright (C) 2012, Riccardo Bernardini
--
-- This file is part of gclp.
--
-- gclp 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.
--
-- gclp 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 gclp. If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------
--
--
with Generic_Line_Parser;
with Ada.Strings.Unbounded;
package body Parsing_Test is
function To_U (X : String) return Unbounded_String
renames To_Unbounded_String;
-- Instantiate the new package
package Line_Parser is
new Generic_Line_Parser (Config_Data);
-- ------------------- --
-- Parameter Callbacks --
-- ------------------- --
-- X Parameter callbak
procedure X_Parameter (Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out Config_Data)
is
begin
Result.X := Line_Parser.To_Natural (Value);
end X_Parameter;
-- Y Parameter callbak
procedure Y_Parameter (Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out Config_Data)
is
begin
Result.Y := Line_Parser.To_Natural (Value);
end Y_Parameter;
procedure Z_Parameter (Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out Config_Data)
is
begin
Result.Z := Line_Parser.To_Float (Value);
end Z_Parameter;
-- Y Parameter callbak
procedure File_Parameter (Name : in Unbounded_String;
Value : in Unbounded_String;
Result : in out Config_Data)
is
begin
Result.Filename := Value;
end File_Parameter;
Param_Spec : Line_Parser.Parameter_Descriptor_Array :=
((Name => To_U ("x,X"),
Default => <>,
If_Missing => Line_Parser.Die,
Only_Once => True,
Callback => X_Parameter'Access),
(Name => To_U ("y,Y"),
Default => <>,
If_Missing => Line_Parser.Die,
Only_Once => True,
Callback => Y_Parameter'Access),
(Name => To_U ("z"),
Default => To_U ("3.1415"),
If_Missing => Line_Parser.Use_Default,
Only_Once => True,
Callback => Z_Parameter'Access),
(Name => To_U ("filename,file,input"),
Default => <>,
If_Missing => Line_Parser.Die,
Only_Once => True,
Callback => File_Parameter'Access));
--------------------
-- Get_Parameters --
--------------------
procedure Get_Parameters (Config : out Config_Data) is
begin
Line_Parser.Parse_Command_Line (Parameters => Param_Spec,
Result => Config);
end Get_Parameters;
end Parsing_Test;

38
lib/gclp/test/parsing_test.ads
Unescape View File

@ -0,0 +1,38 @@
----------------------------------------------------------------------------
-- Generic Command Line Parser (gclp)
--
-- Copyright (C) 2012, Riccardo Bernardini
--
-- This file is part of gclp.
--
-- gclp 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.
--
-- gclp 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 gclp. If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package Parsing_Test is
-- This is the minimal interface that you need to export to the main
-- program: the configuration record type declaration and a procedure
-- to initialize it with the command line data.
type Config_Data is
record
X : Integer;
Y : Integer;
Z : Float;
Filename : Unbounded_String;
end record;
procedure Get_Parameters (Config : out Config_Data);
end Parsing_Test;

35
lib/gclp/test/test.adb
Unescape View File

@ -0,0 +1,35 @@
----------------------------------------------------------------------------
-- Generic Command Line Parser (gclp)
--
-- Copyright (C) 2012, Riccardo Bernardini
--
-- This file is part of gclp.
--
-- gclp 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.
--
-- gclp 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 gclp. If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------
--
with Parsing_Test;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test is
Config : Parsing_Test.Config_Data;
begin
Parsing_Test.Get_Parameters (Config);
Put_Line ("X=" & Integer'Image (Config.X));
Put_Line ("Y=" & Integer'Image (Config.Y));
Put_Line ("Z=" & Float'Image (Config.Z));
Put_Line ("file='" & To_String (Config.Filename) & "'");
end Test;

14
lib/gclp/test/test.gpr
Unescape View File

@ -0,0 +1,14 @@
with "../gclp.gpr";
project Test is
for Object_Dir use "bin";
package Compiler is
for Default_Switches ("ada") use ("-gnat05", "-gnata", "-g");
end Compiler;
for Main use ("test.adb");
end Test;

532
src/docker.adb
Unescape View File

@ -0,0 +1,532 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with Ada.Streams;
with AWS.Response;
with AWS.Status;
with AWS.MIME;
with AWS.Messages;
with AWS.Response.Set;
with GNAT.IO;
with Socket;
with HTTP;
with GNATCOLL.JSON;
with Tokenize;
with Globals;
with Utils;
-- build: ctrl+ shift + b
-- check file: alt + v
package body Docker is
use AWS;
use GNAT.IO;
--
-- List containers.
--
function List_Containers (Request : in Status.Data) return Response.Data is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line ("[" & X_Forwarded_User & "] list containers");
Build_Request :
declare
Is_Admin : Boolean := Utils.Is_Admin (X_Forwarded_User);
begin
if Is_Admin then
Message :=
To_Unbounded_String
("GET /containers/json?size=true&filters={""label"":[""codefirst-usercontainer=true""]} HTTP/1.0" &
ASCII.CR & ASCII.LF & ASCII.CR & ASCII.LF);
else
Message :=
To_Unbounded_String
("GET /containers/json?size=true&filters={""label"":[""" &
X_Forwarded_User & "=admin""]} HTTP/1.0" & ASCII.CR &
ASCII.LF & ASCII.CR & ASCII.LF);
end if;
end Build_Request;
-- Put_Line (To_String (Message));
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
-- Put_Line (To_String (HTTP_Response.Body_Content));
return Resp;
end List_Containers;
--
-- Create container.
--
function Create_Container
(Request : in Status.Data; Container_Name : in String)
return Response.Data
is
use GNATCOLL;
use Ada.Streams;
use Globals;
Container : JSON.JSON_Value;
New_Container : JSON.JSON_Value := JSON.Create_Object;
New_Container_Name : Unbounded_String;
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line
("[" & X_Forwarded_User & "] create container " & Container_Name);
declare
Body_Content : String := HTTP.Extract_Request_Body (Request);
New_Body_Content : Unbounded_String;
New_Body_Content_Len : Natural;
Image_Name : JSON.UTF8_Unbounded_String;
Admins : JSON.UTF8_Unbounded_String;
Private_Container : Boolean := False;
Env_Variables : JSON.JSON_Array;
Labels : JSON.JSON_Value := JSON.Create_Object;
HostConfig : JSON.JSON_Value := JSON.Create_Object;
RestartPolicy : JSON.JSON_Value := JSON.Create_Object;
NetworkMode : JSON.UTF8_Unbounded_String;
begin
Container := JSON.Read (Body_Content);
-- Building new container name;
-- Append (New_Container_Name, Container_Name & "-" & X_Forwarded_User);
Append (New_Container_Name, Container_Name);
-- Getting required image name.
if not JSON.Has_Field (Container, "Image") then
return
Response.Acknowledge
(Messages.S400, "Image name missing.", MIME.Text_Plain);
end if;
Image_Name := JSON.Get (Container, "Image");
-- Private container ?
if JSON.Has_Field (Container, "Private") then
Private_Container := True;
end if;
-- Admins: comma separated list of admins with the syntax "firstname.lastname".
if JSON.Has_Field (Container, "Admins") then
Admins := JSON.Get (Container, "Admins");
end if;
declare
Splitted_Admins : Tokenize.Token_Array :=
Tokenize.Split (To_String (Admins), ',');
begin
Set_Admins:
for I in Splitted_Admins'Range loop
JSON.Set_Field
(Labels, To_String (Splitted_Admins (I)), "admin");
end loop Set_Admins;
end;
JSON.Set_Field (Labels, X_Forwarded_User, "admin");
-- Getting optionnal Env values.
if JSON.Has_Field (Container, "Env") then
Env_Variables := JSON.Get (Container, "Env");
end if;
-- Configuring network.
JSON.Set_Field (RestartPolicy, "Name", "unless-stopped");
JSON.Set_Field
(RestartPolicy, "MaximumRetryCount", Integer'Value ("0"));
JSON.Set_Field (HostConfig, "NetworkMode", Param_DockerNetworkName);
JSON.Set_Field (HostConfig, "RestartPolicy", RestartPolicy);
JSON.Set_Field (New_Container, "HostConfig", HostConfig);
-- Building labels.
JSON.Set_Field
(Labels,
"traefik.http.routers." & To_String (New_Container_Name) & ".rule",
"Host(`" & Param_Hostname & "`) && PathPrefix(`/" &
Param_DockerPathPrefix & "/" & To_String (New_Container_Name) &
"`)");
JSON.Set_Field
(Labels,
"traefik.http.routers." & To_String (New_Container_Name) &
".entrypoints",
"websecure");
JSON.Set_Field
(Labels,
"traefik.http.routers." & To_String (New_Container_Name) &
".tls.certresolver",
"letsEncrypt");
JSON.Set_Field
(Labels,
"traefik.http.middlewares.strip-" &
To_String (New_Container_Name) & ".stripprefix.prefixes",
"/" & Param_DockerPathPrefix & "/" &
To_String (New_Container_Name));
JSON.Set_Field
(Labels,
"traefik.http.routers." & To_String (New_Container_Name) &
".middlewares",
"strip-" & To_String (New_Container_Name) & "@docker");
JSON.Set_Field
(Labels, "codefirst-containername", To_String (New_Container_Name));
JSON.Set_Field (Labels, "codefirst-user", X_Forwarded_User);
JSON.Set_Field (Labels, "codefirst-usercontainer", "true");
JSON.Set_Field
(Labels, "traefik.docker.network", Param_DockerNetworkName);
if Private_Container then
JSON.Set_Field (Labels, "codefirst-private", "true");
JSON.Set_Field
(Labels, "codefirst-container-endpoint",
To_String (New_Container_Name));
else
JSON.Set_Field (Labels, "traefik.enable", "true");
JSON.Set_Field (Labels, "codefirst-private", "false");
JSON.Set_Field
(Labels, "codefirst-container-endpoint",
Param_Scheme & "://" & Param_Hostname & "/" &
Param_DockerPathPrefix & "/" & To_String (New_Container_Name));
end if;
-- Building final new container.
JSON.Set_Field (New_Container, "Image", Image_Name);
JSON.Set_Field (New_Container, "Labels", Labels);
JSON.Set_Field (New_Container, "Env", Env_Variables);
New_Body_Content := To_Unbounded_String (JSON.Write (New_Container));
New_Body_Content_Len := Length (New_Body_Content);
Message :=
To_Unbounded_String
("POST /containers/create?name=" &
To_String (New_Container_Name) & " HTTP/1.0" & ASCII.CR &
ASCII.LF & "Content-Type: application/json" & ASCII.CR &
ASCII.LF & "Host: docker" & ASCII.CR & ASCII.LF &
"Content-length: " & New_Body_Content_Len'Img & ASCII.CR &
ASCII.LF & "Connection: close" & ASCII.CR & ASCII.LF & ASCII.CR &
ASCII.LF & To_String (New_Body_Content) & ASCII.CR & ASCII.LF &
"EOF" & ASCII.CR & ASCII.LF);
end;
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Create_Container;
--
-- Start container.
--
function Start_Container
(Request : in Status.Data; Container_Id : in String) return Response.Data
is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line ("[" & X_Forwarded_User & "] start container " & Container_Id);
if (Container_Id'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Container ID missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("POST /containers/" & Container_Id & "/start HTTP/1.0" & ASCII.CR &
ASCII.LF & ASCII.CR & ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Start_Container;
--
-- Stop container.
--
function Stop_Container
(Request : in Status.Data; Container_Id : in String) return Response.Data
is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line ("[" & X_Forwarded_User & "] stop container " & Container_Id);
if (Container_Id'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Container ID missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("POST /containers/" & Container_Id & "/stop?t=10 HTTP/1.0" &
ASCII.CR & ASCII.LF & ASCII.CR & ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Stop_Container;
--
-- Inspect container.
--
function Inspect_Container
(Request : in Status.Data; Container_Id : in String) return Response.Data
is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line
("[" & X_Forwarded_User & "] inspect container " & Container_Id);
if (Container_Id'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Container ID missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("GET /containers/" & Container_Id & "/json HTTP/1.0" & ASCII.CR &
ASCII.LF & ASCII.CR & ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Inspect_Container;
--
-- Get container log.
--
function Get_Container_Log
(Request : in Status.Data; Container_Id : in String) return Response.Data
is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line
("[" & X_Forwarded_User & "] get container log " & Container_Id);
if (Container_Id'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Container ID missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("GET /containers/" & Container_Id &
"/logs?stdout=true&stderr=true HTTP/1.0" & ASCII.CR & ASCII.LF &
ASCII.CR & ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Get_Container_Log;
--
-- Remove container.
--
function Remove_Container
(Request : in Status.Data; Container_Id : in String) return Response.Data
is
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Resp : Response.Data;
begin
Put_Line ("[" & X_Forwarded_User & "] remove container " & Container_Id);
if (Container_Id'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Container ID missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("DELETE /containers/" & Container_Id &
"?v=true&force=true HTTP/1.0" & ASCII.CR & ASCII.LF & ASCII.CR &
ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Remove_Container;
--
-- Create image.
--
function Create_Image
(Request : in Status.Data; Image_Name : in String) return Response.Data
is
New_Image_Name : Unbounded_String := To_Unbounded_String (Image_Name);
Message : Unbounded_String;
Socket_Response_Vec : Socket.Socket_Response_Vectors.Vector;
HTTP_Response : HTTP.Response;
X_Forwarded_User : String := HTTP.Get_X_Forwarded_User (Request);
Image_Has_Tag : Boolean := False;
Resp : Response.Data;
begin
Put_Line ("[" & X_Forwarded_User & "] create image from " & Image_Name);
for i in Image_Name'Range loop
if (Image_Name (i) = ':') then
Image_Has_Tag := True;
end if;
end loop;
if not Image_Has_Tag then
Append (New_Image_Name, ":latest");
end if;
if (Image_Name'Length = 0) then
return
Response.Acknowledge
(Messages.S400, "Image name missing.", MIME.Text_Plain);
end if;
Message :=
To_Unbounded_String
("POST /images/create?fromImage=" & To_String (New_Image_Name) &
" HTTP/1.0" & ASCII.CR & ASCII.LF &
"Content-Type: application/tar" & ASCII.CR & ASCII.LF & ASCII.CR &
ASCII.LF & ASCII.CR & ASCII.LF);
Socket_Response_Vec := Socket.Send_To_Socket (To_String (Message));
HTTP_Response := HTTP.From_Socket_Response (Socket_Response_Vec);
Resp :=
Response.Build
(Content_Type => MIME.Application_JSON,
Message_Body => To_String (HTTP_Response.Body_Content),
Status_Code => HTTP_Response.Status_Code);
AWS.Response.Set.Add_Header (Resp, "access-control-allow-origin", "* ");
return Resp;
end Create_Image;
end Docker;

24
src/docker.ads
Unescape View File

@ -0,0 +1,24 @@
with AWS.Response;
with AWS.Status;
package Docker is
use AWS;
function List_Containers (Request : in Status.Data) return Response.Data;
function Start_Container (Request : in Status.Data; Container_Id : in String) return Response.Data;
function Stop_Container (Request : in Status.Data; Container_Id : in String) return Response.Data;
function Create_Container (Request : in Status.Data; Container_Name : in String) return Response.Data;
function Remove_Container (Request : in Status.Data; Container_Id : in String) return Response.Data;
function Inspect_Container (Request : in Status.Data; Container_Id : in String) return Response.Data;
function Get_Container_Log (Request : in Status.Data; Container_Id : in String) return Response.Data;
function Create_Image (Request : in Status.Data; Image_Name : in String) return Response.Data;
end Docker;

168
src/dockerproxy-callbacks.adb
Unescape View File

@ -0,0 +1,168 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Bounded; use Ada.Strings.Bounded;
with AWS.Messages;
with AWS.MIME;
with AWS.Status;
with AWS.Response.Set;
with GNAT.Regpat;
with GNAT.IO;
with Docker;
with Types;
package body Dockerproxy.Callbacks is
-- Container names are max 128 characters.
use Types.Container_Name_Str;
-------------
-- Default --
-------------
function Default (Request : in Status.Data) return Response.Data is
use AWS.Status;
use GNAT.Regpat;
use GNAT.IO;
use Ada.Strings.Unbounded;
URI : constant String := Status.URI (Request);
Method : constant Request_Method := Status.Method (Request);
Create_Container_Re : Pattern_Matcher (100);
Create_Container_Matches : Match_Array (1 .. 1);
Remove_Container_Re : Pattern_Matcher (100);
Remove_Container_Matches : Match_Array (1 .. 1);
List_Containers_Re : Pattern_Matcher (100);
List_Containers_Matches : Match_Array (1 .. 1);
Get_Container_Log_Re : Pattern_Matcher (100);
Get_Container_Log_Matches : Match_Array (1 .. 1);
Inspect_Container_Re : Pattern_Matcher (100);
Inspect_Container_Matches : Match_Array (1 .. 1);
Start_Container_Re : Pattern_Matcher (100);
Start_Container_Matches : Match_Array (1 .. 1);
Stop_Container_Re : Pattern_Matcher (100);
Stop_Container_Matches : Match_Array (1 .. 1);
Create_Image_Re : Pattern_Matcher (100);
Create_Image_Matches : Match_Array (1 .. 1);
-- Container name or ID, image name...
Request_Variable_Part : Bounded_String;
begin
Compile (Create_Container_Re, "/containers/create/(.+)");
Compile (Remove_Container_Re, "/containers/(.+)");
Compile (List_Containers_Re, "(/containers/json)");
Compile (Get_Container_Log_Re, "/containers/(.+)/logs");
Compile (Inspect_Container_Re, "/containers/(.+)/json");
Compile (Start_Container_Re, "/containers/(.+)/start");
Compile (Stop_Container_Re, "/containers/(.+)/stop");
Compile (Create_Image_Re, "(/images/create)");
Match (Create_Container_Re, URI, Create_Container_Matches);
Match (Remove_Container_Re, URI, Remove_Container_Matches);
Match (List_Containers_Re, URI, List_Containers_Matches);
Match (Get_Container_Log_Re, URI, Get_Container_Log_Matches);
Match (Inspect_Container_Re, URI, Inspect_Container_Matches);
Match (Start_Container_Re, URI, Start_Container_Matches);
Match (Stop_Container_Re, URI, Stop_Container_Matches);
Match (Create_Image_Re, URI, Create_Image_Matches);
if
(Create_Container_Matches (1) /= No_Match and
Method = Request_Method'(POST))
then
Set_Bounded_String (Request_Variable_Part, URI (Create_Container_Matches (1).First .. Create_Container_Matches (1).Last));
return Docker.Create_Container (Request, To_String (Request_Variable_Part));
elsif
(Remove_Container_Matches (1) /= No_Match and
Method = Request_Method'(DELETE))
then
Set_Bounded_String (Request_Variable_Part, URI (Remove_Container_Matches (1).First .. Remove_Container_Matches (1).Last));
return Docker.Remove_Container (Request, To_String (Request_Variable_Part));
elsif
(List_Containers_Matches (1) /= No_Match and
Method = Request_Method'(GET))
then
return Docker.List_Containers (Request);
elsif
(Get_Container_Log_Matches (1) /= No_Match and
Method = Request_Method'(GET))
then
Set_Bounded_String (Request_Variable_Part, URI (Get_Container_Log_Matches (1).First .. Get_Container_Log_Matches (1).Last));
return Docker.Get_Container_Log (Request, To_String (Request_Variable_Part));
elsif
(Inspect_Container_Matches (1) /= No_Match and
Method = Request_Method'(GET))
then
Set_Bounded_String (Request_Variable_Part, URI (Inspect_Container_Matches (1).First .. Inspect_Container_Matches (1).Last));
return Docker.Inspect_Container (Request, To_String (Request_Variable_Part));
elsif
(Start_Container_Matches (1) /= No_Match and
Method = Request_Method'(POST))
then
Set_Bounded_String (Request_Variable_Part, URI (Start_Container_Matches (1).First .. Start_Container_Matches (1).Last));
return Docker.Start_Container (Request, To_String (Request_Variable_Part));
elsif
(Stop_Container_Matches (1) /= No_Match and
Method = Request_Method'(POST))
then
Set_Bounded_String (Request_Variable_Part, URI (Stop_Container_Matches (1).First .. Stop_Container_Matches (1).Last));
return Docker.Stop_Container (Request, To_String (Request_Variable_Part));
elsif
(Create_Image_Matches (1) /= No_Match and
Method = Request_Method'(POST))
then
declare
Image_Name : String := AWS.Status.Parameter (Request, "fromImage");
begin
return Docker.Create_Image (Request, Image_Name);
end;
elsif (Method = Request_Method'(OPTIONS)) then
declare
Resp : Response.Data;
begin
Resp :=
Response.Build
(Content_Type => MIME.Text_Plain, Message_Body => "No content",
Status_Code => Messages.S204);
AWS.Response.Set.Add_Header
(Resp, "Access-Control-Allow-Origin", "* ");
AWS.Response.Set.Add_Header
(Resp, "Access-Control-Allow-Methods",
"GET, OPTIONS, POST, PUT, DELETE");
return Resp;
end;
else
return Response.Acknowledge (Messages.S404);
end if;
end Default;
end Dockerproxy.Callbacks;

11
src/dockerproxy-callbacks.ads
Unescape View File

@ -0,0 +1,11 @@
with AWS.Response;
with AWS.Status;
package Dockerproxy.Callbacks is
use AWS;
function Default (Request : in Status.Data) return Response.Data;
end Dockerproxy.Callbacks;

105
src/dockerproxy-main.adb
Unescape View File

@ -0,0 +1,105 @@
with GNAT.IO; use GNAT.IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with AWS.Config.Set;
with AWS.Server;
with Dockerproxy.Callbacks;
with Generic_Line_Parser;
with Parameters;
with Globals;
procedure Dockerproxy.Main is
use AWS;
Web_Server : Server.HTTP;
Web_Config : Config.Object;
package Line_Parser is new Generic_Line_Parser (Parameters.User_Parameters);
use type Line_Parser.Missing_Action;
Descriptors : constant Line_Parser.Parameter_Descriptor_Array :=
[(Name => To_Unbounded_String ("--hostname"),
Default => To_Unbounded_String ("localhost"), Only_Once => True,
If_Missing => Line_Parser.Use_Default,
Callback => Parameters.Set_Hostname'Access),
(Name => To_Unbounded_String ("--scheme"),
Default => To_Unbounded_String ("http"), Only_Once => True,
If_Missing => Line_Parser.Use_Default,
Callback => Parameters.Set_Scheme'Access),
(Name => To_Unbounded_String ("--dockerpathprefix"),
Default => To_Unbounded_String ("containers"), Only_Once => True,
If_Missing => Line_Parser.Use_Default,
Callback => Parameters.Set_DockerPathPrefix'Access),
(Name => To_Unbounded_String ("--dockernetworkname"),
Default => To_Unbounded_String ("run_net"), Only_Once => True,
If_Missing => Line_Parser.Use_Default,
Callback => Parameters.Set_DockerNetworkName'Access),
(Name => To_Unbounded_String ("--maxallowedcontainers"),
Default => To_Unbounded_String ("3"), Only_Once => True,
If_Missing => Line_Parser.Use_Default,
Callback => Parameters.Set_MaxAllowedContainers'Access),
(Name => To_Unbounded_String ("--devel,-d"),
Default => To_Unbounded_String (""), Only_Once => True,
If_Missing => Line_Parser.Ignore,
Callback => Parameters.Set_Devel'Access),
(Name => To_Unbounded_String ("--admins"),
Default => To_Unbounded_String (""), Only_Once => True,
If_Missing => Line_Parser.Ignore,
Callback => Parameters.Set_Admins'Access)];
Param : Parameters.User_Parameters;
begin
-- Command line parameters
Line_Parser.Parse_Command_Line (Parameters => Descriptors, Result => Param);
Globals.Param_Devel := Param.Devel;
Globals.Param_Admins := Param.Admins;
Globals.Param_DockerNetworkName := Param.DockerNetworkName;
Globals.Param_DockerPathPrefix := Param.DockerPathPrefix;
Globals.Param_Hostname := Param.Hostname;
Globals.Param_MaxAllowedContainers := Param.MaxAllowedContainers;
Globals.Param_Scheme := Param.Scheme;
Put_Line ("--devel => " & To_String (Param.Devel));
Put_Line ("--hostname => " & To_String (Param.Hostname));
Put_Line ("--scheme => " & To_String (Param.Scheme));
Put_Line ("--dockerpathprefix => " & To_String (Param.DockerPathPrefix));
Put_Line ("--dockernetworkname => " & To_String (Param.DockerNetworkName));
Put_Line ("--maxallowedcontainers => " & Param.MaxAllowedContainers'Img);
for admin of Param.Admins loop
Put_Line ("-admin: " & To_String (admin));
end loop;
-- Setup
Config.Set.Server_Host (Web_Config, Host);
Config.Set.Server_Port (Web_Config, Port);
-- Start the server
Server.Start (Web_Server, Callbacks.Default'Access, Web_Config);
-- Wait for the Q key
Server.Wait (Server.Forever);
-- Server.Wait (Server.Q_Key_Pressed);
-- Stop the server
Server.Shutdown (Web_Server);
end Dockerproxy.Main;

8
src/dockerproxy.ads
Unescape View File

@ -0,0 +1,8 @@
package Dockerproxy is
pragma Pure;
Host : constant String := "0.0.0.0";
Port : constant := 8080;
end Dockerproxy;

18
src/globals.ads
Unescape View File

@ -0,0 +1,18 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Parameters;
with Types;
package Globals is
use Types;
Param_Devel : Unbounded_String;
Param_Admins : Parameters.Admins_Vector.Vector;
Param_Hostname : Unbounded_String;
Param_Scheme : Unbounded_String;
Param_DockerPathPrefix : Unbounded_String;
Param_DockerNetworkName : Unbounded_String;
Param_MaxAllowedContainers : MaxAllowedContainers_Type;
end Globals;

142
src/http-status.adb
Unescape View File

@ -0,0 +1,142 @@
package body HTTP.Status is
function AWS_StatusCode_From_String
(StatusCode_String : in String) return AWS.Messages.Status_Code
is
use AWS.Messages;
Status : AWS.Messages.Status_Code;
begin
if StatusCode_String = "100" then
Status := S100;
elsif StatusCode_String = "101" then
Status := S101;
elsif StatusCode_String = "102" then
Status := S102;
elsif StatusCode_String = "200" then
Status := S200;
elsif StatusCode_String = "201" then
Status := S201;
elsif StatusCode_String = "202" then
Status := S202;
elsif StatusCode_String = "203" then
Status := S203;
elsif StatusCode_String = "204" then
Status := S204;
elsif StatusCode_String = "205" then
Status := S205;
elsif StatusCode_String = "206" then
Status := S206;
elsif StatusCode_String = "207" then
Status := S207;
elsif StatusCode_String = "208" then
Status := S208;
elsif StatusCode_String = "226" then
Status := S226;
elsif StatusCode_String = "300" then
Status := S300;
elsif StatusCode_String = "301" then
Status := S301;
elsif StatusCode_String = "302" then
Status := S302;
elsif StatusCode_String = "303" then
Status := S303;
elsif StatusCode_String = "304" then
Status := S304;
elsif StatusCode_String = "305" then
Status := S305;
elsif StatusCode_String = "306" then
Status := S306;
elsif StatusCode_String = "307" then
Status := S307;
elsif StatusCode_String = "308" then
Status := S308;
elsif StatusCode_String = "400" then
Status := S400;
elsif StatusCode_String = "401" then
Status := S401;
elsif StatusCode_String = "402" then
Status := S402;
elsif StatusCode_String = "403" then
Status := S403;
elsif StatusCode_String = "404" then
Status := S404;
elsif StatusCode_String = "405" then
Status := S405;
elsif StatusCode_String = "406" then
Status := S406;
elsif StatusCode_String = "407" then
Status := S407;
elsif StatusCode_String = "408" then
Status := S408;
elsif StatusCode_String = "409" then
Status := S409;
elsif StatusCode_String = "410" then
Status := S410;
elsif StatusCode_String = "411" then
Status := S411;
elsif StatusCode_String = "412" then
Status := S412;
elsif StatusCode_String = "413" then
Status := S413;
elsif StatusCode_String = "414" then
Status := S414;
elsif StatusCode_String = "415" then
Status := S415;
elsif StatusCode_String = "416" then
Status := S416;
elsif StatusCode_String = "417" then
Status := S417;
elsif StatusCode_String = "418" then
Status := S418;
elsif StatusCode_String = "421" then
Status := S421;
elsif StatusCode_String = "422" then
Status := S422;
elsif StatusCode_String = "423" then
Status := S423;
elsif StatusCode_String = "424" then
Status := S424;
elsif StatusCode_String = "425" then
Status := S425;
elsif StatusCode_String = "426" then
Status := S426;
elsif StatusCode_String = "428" then
Status := S428;
elsif StatusCode_String = "429" then
Status := S429;
elsif StatusCode_String = "431" then
Status := S431;
elsif StatusCode_String = "451" then
Status := S451;
elsif StatusCode_String = "500" then
Status := S500;
elsif StatusCode_String = "501" then
Status := S501;
elsif StatusCode_String = "502" then
Status := S502;
elsif StatusCode_String = "503" then
Status := S503;
elsif StatusCode_String = "504" then
Status := S504;
elsif StatusCode_String = "505" then
Status := S505;
elsif StatusCode_String = "506" then
Status := S506;
elsif StatusCode_String = "507" then
Status := S507;
elsif StatusCode_String = "508" then
Status := S508;
elsif StatusCode_String = "510" then
Status := S510;
elsif StatusCode_String = "511" then
Status := S511;
end if;
return Status;
end AWS_StatusCode_From_String;
end HTTP.Status;

12
src/http-status.ads
Unescape View File

@ -0,0 +1,12 @@
with AWS.Messages;
package HTTP.Status is
function AWS_StatusCode_From_String
(StatusCode_String : in String)
return AWS.Messages.Status_Code with
Pre => StatusCode_String'Length > 0,
Post =>
AWS_StatusCode_From_String'Result in AWS.Messages.Status_Code;
end HTTP.Status;

158
src/http.adb
Unescape View File

@ -0,0 +1,158 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Maps;
with AWS.Headers;
with AWS.Status;
with Tokenize;
with GNAT.IO; use GNAT.IO;
use type Ada.Strings.Maps.Character_Set;
with Ada.Streams; use Ada.Streams;
use type Ada.Streams.Stream_Element_Count;
with HTTP.Status;
with Globals;
package body HTTP is
function From_Socket_Response
(Socket_Response_Vec : in Socket.Socket_Response_Vectors.Vector) return Response
is
HTTP_Response : Response;
Body_Reached : Boolean := False;
begin
-- Building the HTTP response from the socket response.
for I in
Socket_Response_Vec.First_Index .. Socket_Response_Vec.Last_Index
loop
declare
Current_Line : Unbounded_String;
Current_Line_Len : Natural;
Header_Separator_Index : Natural;
Status_Code_String : String (1 .. 3);
begin
Current_Line := Socket_Response_Vec (I);
Current_Line_Len := Length (Current_Line);
Header_Separator_Index := Index (Current_Line, ":");
-- Put_Line (To_String (Current_Line));
-- Put_Line (Current_Line_Len'Img);
-- First line is the HTTP status like: HTTP/1.0 200 OK
if I = 0 then
-- Put_Line ("HTTP status reached");
declare
Splitted_HTTP_Status : Tokenize.Token_Array :=
Tokenize.Split (To_String (Current_Line));
begin
Status_Code_String := To_String (Splitted_HTTP_Status (2));
end;
HTTP_Response.Status_Code := HTTP.Status.AWS_StatusCode_From_String
(Status_Code_String);
elsif Current_Line_Len = 0 then
-- Put_Line ("Body reached");
Body_Reached := True;
elsif Body_Reached then
-- Put_Line ("Body");
Ada.Strings.Unbounded.Append
(HTTP_Response.Body_Content, Current_Line);
else
-- Put_Line ("Headers reached");
declare
Header_Key :
String (1 .. (Header_Separator_Index - 1));
Header_Value :
String
(Header_Separator_Index .. (Current_Line_Len));
begin
Header_Key :=
To_String (Current_Line)
(1 .. (Header_Separator_Index - 1));
Header_Value :=
To_String (Current_Line)
(Header_Separator_Index .. (Current_Line_Len));
-- Put_Line ("Header key " & Header_Key);
-- Put_Line ("Header value " & Header_Value);
end;
end if;
end;
end loop;
return HTTP_Response;
end From_Socket_Response;
function Get_X_Forwarded_User (Request : in AWS.Status.Data) return String
is
Headers : AWS.Headers.List;
Separators : Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.Null_Set;
begin
Headers := AWS.Status.Header (Request);
Separators := Ada.Strings.Maps.To_Set ("@.");
if Length (Globals.Param_Devel) /= 0 then
return To_String (Globals.Param_Devel);
end if;
declare
-- X-Forwarded-User contains the user email coming from codefirst auth proxy or any string coming from drone.
X_Header : String :=
AWS.Headers.Get_Values (Headers, "X-Forwarded-User");
Splitted_Email : Tokenize.Token_Array :=
Tokenize.Split (X_Header, Separators, True);
Final_X_Header : Unbounded_String;
begin
if X_Header'Length = 0 then
return "";
end if;
Splitted_Email := Tokenize.Split (X_Header, Separators, True);
Append (Final_X_Header, Splitted_Email (1));
if Splitted_Email'Length > 1 then
Append (Final_X_Header, Splitted_Email (2));
end if;
return To_String (Final_X_Header);
end;
end Get_X_Forwarded_User;
function Extract_Request_Body (Request : in AWS.Status.Data) return String
is
Offset : Stream_Element_Count;
Data : Stream_Element_Array (1 .. 256);
Body_Content : Unbounded_String;
begin
loop
AWS.Status.Read_Body (Request, Data, Offset);
exit when Offset = 0;
for I in 1 .. Offset loop
Append (Body_Content, Character'Val (Data (I)));
end loop;
end loop;
return To_String (Body_Content);
end Extract_Request_Body;
end HTTP;

27
src/http.ads
Unescape View File

@ -0,0 +1,27 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with AWS.Messages;
with AWS.Status;
with Socket;
package HTTP is
type Response is record
Status_Code : AWS.Messages.Status_Code;
Body_Content : Unbounded_String;
end record;
function Extract_Request_Body
(Request : in AWS.Status.Data) return String with
Pre => AWS.Status.Content_Type (Request) /= "0";
function From_Socket_Response
(Socket_Response_Vec : in Socket.Socket_Response_Vectors.Vector)
return Response;
function Get_X_Forwarded_User
(Request : in AWS.Status.Data) return String with
Post => Get_X_Forwarded_User'Result'Length /= 0;
end HTTP;

105
src/parameters.adb
Unescape View File

@ -0,0 +1,105 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Tokenize;
package body Parameters is
--
-- Admins.
--
procedure Set_Admins
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
declare
Splitted_Admins : constant Tokenize.Token_Array :=
Tokenize.Split (To_String (Value), ',');
begin
for i in Splitted_Admins'Range loop
Result.Admins.Append (Splitted_Admins (i));
end loop;
end;
end Set_Admins;
--
-- Devel.
--
procedure Set_Devel
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.Devel := Value;
end Set_Devel;
--
-- Hostname.
--
procedure Set_Hostname
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.Hostname := Value;
end Set_Hostname;
--
-- Scheme.
--
procedure Set_Scheme
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.Scheme := Value;
end Set_Scheme;
--
-- Docker path prefix.
--
procedure Set_DockerPathPrefix
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.DockerPathPrefix := Value;
end Set_DockerPathPrefix;
--
-- Docker network name.
--
procedure Set_DockerNetworkName
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.DockerNetworkName := Value;
end Set_DockerNetworkName;
--
-- Max containers.
--
procedure Set_MaxAllowedContainers
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters)
is
pragma Unreferenced (Name);
begin
Result.MaxAllowedContainers := Natural'Value (To_String (value));
end Set_MaxAllowedContainers;
end Parameters;

51
src/parameters.ads
Unescape View File

@ -0,0 +1,51 @@
with Ada.Strings.Unbounded;
with Ada.Containers.Vectors;
with Types;
package Parameters is
use Ada.Strings.Unbounded;
use Types;
package Admins_Vector is new Ada.Containers.Vectors
(Index_Type => Natural, Element_Type => Unbounded_String);
type User_Parameters is record
Devel : Unbounded_String;
Hostname : Unbounded_String;
Admins : Admins_Vector.Vector;
Scheme : Unbounded_String;
DockerPathPrefix : Unbounded_String;
DockerNetworkName : Unbounded_String;
MaxAllowedContainers : MaxAllowedContainers_Type;
end record;
procedure Set_Admins
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Devel
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Hostname
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_Scheme
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_DockerPathPrefix
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_DockerNetworkName
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
procedure Set_MaxAllowedContainers
(Name : in Unbounded_String; Value : in Unbounded_String;
Result : in out User_Parameters);
end Parameters;

82
src/socket.adb
Unescape View File

@ -0,0 +1,82 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Containers.Vectors;
with Ada.Streams;
use type Ada.Streams.Stream_Element_Count;
with GNAT.IO;
with GNAT.Sockets;
package body Socket is
function Send_To_Socket
(Message : in String) return Socket_Response_Vectors.Vector
is
use Socket_Response_Vectors;
use GNAT.IO;
use GNAT.Sockets;
use Ada.Streams;
Client : Socket_Type;
Channel : Stream_Access;
Offset : Stream_Element_Count;
Data : Stream_Element_Array (1 .. 256);
Socket_Response_Vec : Socket_Response_Vectors.Vector;
begin
-- Connect to socket.
Initialize;
Create_Socket (Socket => Client, Family => Family_Unix);
Connect_Socket
(Socket => Client,
Server =>
(Family => Family_Unix,
Name => To_Unbounded_String ("/var/run/docker.sock")));
Channel := Stream (Client);
-- Send message.
String'Write (Stream (Client), Message);
Build_Socket_Response_Vector :
loop
Read (Channel.all, Data, Offset);
exit when Offset = 0;
declare
Current_Line : Unbounded_String;
Current_Line_Len : Natural;
begin
for I in 1 .. Offset loop
-- Put_Line (Character'Val (Data (I))'Img);
Current_Line_Len := Length (Current_Line);
if Character'Val (Data (I)) = ASCII.CR then
Socket_Response_Vec.Append (Current_Line);
Delete (Current_Line, 1, Current_Line_Len);
elsif Character'Val (Data (I)) /= ASCII.LF then
Append (Current_Line, Character'Val (Data (I)));
end if;
end loop;
Socket_Response_Vec.Append (Current_Line);
end;
end loop Build_Socket_Response_Vector;
Close_Socket (Socket => Client);
return Socket_Response_Vec;
exception
when Socket_Error =>
Put_Line ("Socket error");
Socket_Response_Vec.Append (To_Unbounded_String ("HTTP/1.0 500 Socket_Error"));
return Socket_Response_Vec;
end Send_To_Socket;
end Socket;

16
src/socket.ads
Unescape View File

@ -0,0 +1,16 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Containers.Vectors;
package Socket is
-- Socket_Response_Vectors contains the lines of the socket response.
package Socket_Response_Vectors is new Ada.Containers.Vectors
(Index_Type => Natural, Element_Type => Unbounded_String);
use Socket_Response_Vectors;
function Send_To_Socket
(Message : in String) return Socket_Response_Vectors.Vector with
Post => not Send_To_Socket'Result.Is_Empty;
end Socket;

11
src/types.ads
Unescape View File

@ -0,0 +1,11 @@
with Ada.Strings.Bounded;
package Types is
subtype MaxAllowedContainers_Type is Natural range 1 .. 20;
package Container_Name_Str is new Ada.Strings.Bounded
.Generic_Bounded_Length
(Max => 128);
end Types;

22
src/utils.adb
Unescape View File

@ -0,0 +1,22 @@
with Globals;
with Ada.Strings.Unbounded;
package body Utils is
function Is_Admin (User: string) return Boolean is
use Globals;
use Ada.Strings.Unbounded;
Result : Boolean := false;
begin
for e of Param_Admins loop
if user = To_String (e) then
Result := true;
return Result;
end if;
end loop;
return Result;
end;
end Utils;

5
src/utils.ads
Unescape View File

@ -0,0 +1,5 @@
package Utils is
function Is_Admin (User: string) return Boolean;
end Utils;
Write Preview
Loading…
Cancel
Save