Merge pull request #283 from jajik/perl-tests

Add an initial support of Apache::Test framework

.github/workflows/ci.yml

@@ -164,7 +164,7 @@ jobs:
                       --with-port=8000
           sudo make
           sudo make install
-      - name: Build mod_proxy_cluster
+      - name: Build mod_proxy_cluster and add it to httpd
         run: |
           ls
           cd mod_proxy_cluster/native
@@ -174,8 +174,15 @@ jobs:
             ./configure CFLAGS="-Wall -Werror" --with-apxs=/usr/local/apache2/bin/apxs; \
             make clean; \
             make || exit 1; \
+            sudo cp *.so /usr/local/apache2/modules; \
             cd ..; \
           done;
+      - name: Preserve built Apache for perl-test job
+        uses: actions/[email protected]
+        with:
+          name: apache-trunk
+          path: /usr/local/apache2
+          retention-days: 0 
 
   cmake-windows-latest:
     runs-on: windows-latest
@@ -259,6 +266,49 @@ jobs:
             test/logs/*
           retention-days: 7
 
+  perl-tests:
+    runs-on: ubuntu-latest
+    needs: make-with-httpd-trunk
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v4
+      - name: Setup dependencies
+        run: |
+          sudo apt update
+          sudo apt remove apache2*
+          sudo apt install -y gcc make perl cpanminus libcrypt-ssleay-perl
+      - name: Get Apache built in the previous job
+        uses: actions/download-artifact@v4
+        with:
+          name: apache-trunk
+          path: apache2
+      - name: Put httpd on the right path
+        run: |
+          mkdir test-perl/t/modules/
+          cp apache2/modules/{mod_proxy_cluster.so,mod_manager.so,mod_advertise.so,mod_lbmethod_cluster.so} test-perl/t/modules/
+          sudo mv apache2/ /usr/local/apache2/
+          sudo chmod -R 755 /usr/local/apache2/
+      - name: Install perl modules
+        run: |
+          sudo cpanm --force Apache::Test Apache::TestMM HTTP::Request LWP::UserAgent
+      - name: Run testsuite
+        run: |
+          cd test-perl
+          perl Makefile.PL -httpd /usr/local/apache2/bin/httpd
+          make
+          t/TEST -httpd /usr/local/apache2/bin/httpd 2>&1 | tee test-perl.log
+          mv test-perl.log t/logs/test-perl.log
+          grep "Result: PASS" -q t/logs/test-perl.log
+          exit $?
+      - name: Preserve test logs
+        uses: actions/upload-artifact@v4
+        if: always()
+        with:
+          name: Perl tests logs
+          path: |
+            test-perl/t/logs/*
+          retention-days: 7
+
   doxygen:
     runs-on: ubuntu-latest
     steps:

.gitignore

@@ -8,14 +8,13 @@
 *.ipr
 *.iml
 
+# vim
+*.swp
+
 # Visual Studio Code IDE
 .vscode/
 
 # Native built files
-native/*/*.slo
-native/*/*.so
-native/*/*.lo
-native/*/*.o
 native/*/.libs/
 native/*/Makefile
 native/*/autom4te.cache/
@@ -37,6 +36,12 @@ test/httpd/mod_proxy_cluster
 # Log files
 **/*.log
 
+# build files
+*.slo
+*.so
+*.lo
+*.o
+
 # test files
 **/nohup.out
 test/MODCLUSTER-640/mod_proxy_cluster_new.conf
@@ -46,6 +51,15 @@ test/new.xml
 test/server.xml
 test/includes/dependency-reduced-pom.xml
 
+# perl test files
+test-perl/MYMETA*
+test-perl/Makefile
+test-perl/blib/**
+test-perl/pm_to_blib
+test-perl/t/conf/*.conf
+test-perl/t/conf/apache_test_config.pm
+test-perl/t/logs/**
+
 # patch files
 **/*.patch
 

test-perl/Makefile.PL

@@ -0,0 +1,29 @@
+use v5.32;
+use ExtUtils::MakeMaker;
+use Apache::TestMM qw(test clean);
+use Apache::TestMM qw(test clean);
+use Apache::TestReport ();
+use Apache::TestSmoke ();
+use Apache::TestRun ();
+
+use File::Find qw(finddepth);
+
+my @scripts = ();
+
+finddepth(sub {
+    return unless /^(?!.#)(.*?\.pl)\.PL$/;
+    push @scripts, "$File::Find::dir/$1";
+}, '.');
+
+Apache::TestMM::filter_args();
+
+for my $script (@scripts) {
+	Apache::TestMM::generate_script($script);
+}
+
+
+WriteMakefile(
+    NAME    => 'mpc-test',
+    VERSION => '0.0.1'
+);
+

test-perl/README.md

@@ -0,0 +1,42 @@
+# Testsuite based on httpd-tests
+
+This testsuite is based on perl testing framework for Apache.
+
+To run these tests, you will need `httpd`, `perl` and `cpan`. You will be required to compile
+this project as well, for more information see the `native/` directory at root of this
+repository.
+
+## Dependencies
+
+On Fedora, install `perl-Test` and `perl-ExtUtils-MakeMaker`. Then install required packages
+from `cpan`:
+
+```
+cpan install Bundle::ApacheTest Apache::TestMM HTTP::Request
+```
+
+Then compile the four modules provided by this repository and place the built modules into `t/modules/`
+directory.
+
+## Running tests
+
+To run tests just execute following:
+
+```
+perl Makefile.PL
+make
+t/TEST
+```
+
+In case you have a custom installation of httpd, you'll be probably required to provide its path. E.g.,
+in case of httpd installed under `/opt/apache2/`, execute following:
+
+```
+perl Makefile.PL -apxs /opt/apache2/bin/apxs
+make
+t/TEST -apxs /opt/apache2/bin/apxs
+```
+
+For more information about the testing framework see the official
+[documentation](https://perl.apache.org/docs/general/testing/testing.html).
+

test-perl/lib/ModProxyCluster.pm

@@ -0,0 +1,194 @@
+package ModProxyCluster;
+
+use v5.32;
+
+require Exporter;
+use HTTP::Request;
+use HTTP::Request::Common;
+use LWP::UserAgent;
+
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(
+  CMD
+  parse_params
+  parse_response
+);
+
+our $VERSION = '0.0.1';
+
+sub CMD_internal {
+	my ($cmd, $url, $params) = @_;
+	my $header = [];
+
+	my $ua = LWP::UserAgent->new();
+	my $request = HTTP::Request->new($cmd, $url, $header, $params);
+
+	return $ua->request($request);
+}
+
+sub concat_params {
+	my (%params) = @_;
+	my $p = "";
+	my $d = "";
+
+	foreach my $k (sort(keys %params)) {
+		if ($params{$k}) {
+			$p .= $d . $k . '=' . $params{$k};
+			$d = "&";
+		}
+	}
+
+	return $p;
+}
+
+sub parse_two_layers {
+	my ($d1, $d2, $string) = @_;
+
+	my %params;
+	for my $pair (split $d1, $string) {
+		my ($key, $val) = split $d2, $pair;
+		# Needed because of the leading whitespace before Type field in DUMP/node...
+		# TODO: Remove this after we fix the issue...
+		(my $fixkey = $key) =~ s/\s+//g;
+		$params{$fixkey} = $val;
+	}
+
+	return %params;
+
+}
+
+sub parse_params {
+	return parse_two_layers '&', '=', @_;
+}
+
+sub parse_INFO {
+	my $input = shift;
+	my @lines = split '\n', $input;
+	my (@nodes, @hosts, @contexts);
+
+	my $line = "";
+	my $i = 0;
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/Node:/) {
+			last;
+		}
+		my %node = parse_two_layers ',', ': ', $line;
+		push @nodes, \%node;
+	}
+
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/Vhost:/) {
+			last;
+		}
+		my %host = parse_two_layers ',', ': ', $line;
+		push @hosts, \%host;
+	}
+
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/Context:/) {
+			last;
+		}
+		my %context = parse_two_layers ',', ': ', $line;
+		push @contexts, \%context;
+	}
+
+	# Check that everything was parsed
+	return () if $i != @lines;
+	return (Nodes => \@nodes, Hosts => \@hosts, Contexts => \@contexts );
+}
+
+sub parse_DUMP {
+	my $input = shift;
+	my @lines = split '\n', $input;
+	my (@balancers, @nodes, @hosts, @contexts);
+
+	my $line = "";
+	my $i = 0;
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/^balancer:/) {
+			last
+		}
+		(my $b = $line) =~ s/: /=/g;
+		$b =~ s/\[([^\]]*)\]\/\[([^\]]*)\]/Cookie=$1 Path=$2/;
+		my %balancer = parse_two_layers ' ', '=', $b;
+		push @balancers, \%balancer;
+	}
+
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/^node:/) {
+			last;
+		}
+		(my $n = $line) =~ s/LBGroup: \[([^\]]*)\]/LBGroup: $1/;
+		my %node = parse_two_layers ',', ': ', $n;
+		push @nodes, \%node;
+	}
+
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/^host:/) {
+			last;
+		}
+		(my $h = $line) =~ s/: /=/g;
+		$h =~ s/\[([^\]]*)\]/alias=$1/;
+		my %host = parse_two_layers ' ', '=', $h;
+		push @hosts, \%host;
+	}
+
+
+	for (; $i < @lines; $i++) {
+		$line = $lines[$i];
+		if ($line !~ m/^context:/) {
+			last;
+		}
+		(my $c = $line) =~ s/: /=/g;
+		$c =~ s/\[([^\]]*)\]/path=$1/;
+		my %context = parse_two_layers ' ', '=', $c;
+		push @contexts, \%context;
+	}
+
+	# Check that the whole input was consumed!
+	return () if $i != @lines;
+	return ( Balancers => \@balancers, Nodes => \@nodes, Hosts => \@hosts, Contexts => \@contexts );
+}
+
+sub CMD {
+	my ($cmd, $url, %params) = @_;
+	my @mpc_commands = qw(CONFIG ENABLE-APP DISABLE-APP STOP-APP REMOVE-APP STOP-APP-RSP
+				STATUS STATUS-RSP INFO INFO-RSP DUMP DUMP-RSP PING PING-RSP);
+
+	if (grep /^$cmd$/, @mpc_commands) {
+		return CMD_internal $cmd, $url, concat_params %params;
+	}
+
+	return HTTP::Response->new();
+}
+
+sub parse_response {
+	my ($cmd, $resp) = @_;
+
+	if ($cmd eq 'CONFIG') {
+		return parse_params $resp;
+	} elsif ($cmd eq 'DUMP') {
+		return parse_DUMP $resp;
+	} elsif ($cmd eq 'INFO') {
+		return parse_INFO $resp;
+	} elsif ($cmd eq 'STATUS') {
+		return parse_params $resp;
+	} elsif ($cmd eq 'PING') {
+		return parse_params $resp;
+	} elsif ($cmd eq 'STOP-APP') {
+		return parse_params $resp;
+	}
+
+	return {};
+}
+
+
+1;
+