Merge branch 'perl'

.gitignore

@@ -14,3 +14,4 @@ Makefile.in
 /stamp-h1
 /src/python/location-query
 /test.db
+/testdata.db

Makefile.am

@@ -4,6 +4,11 @@ ACLOCAL_AMFLAGS = -I m4 ${ACLOCAL_FLAGS}
 AM_MAKEFLAGS = --no-print-directory
 
 SUBDIRS = . po
+BINDINGS =
+
+if ENABLE_PERL
+BINDINGS += perl
+endif
 
 AM_CPPFLAGS = \
 	-include $(top_builddir)/config.h \
@@ -122,6 +127,57 @@ src_python_location_la_LIBADD = \
 	src/libloc.la \
 	$(PYTHON_LIBS)
 
+# Compile & install bindings
+all-local: $(foreach binding,$(BINDINGS),build-$(binding))
+check-local: $(foreach binding,$(BINDINGS),check-$(binding))
+install-exec-local: $(foreach binding,$(BINDINGS),install-$(binding))
+clean-local: $(foreach binding,$(BINDINGS),clean-$(binding))
+uninstall-local: $(foreach binding,$(BINDINGS),uninstall-$(binding))
+
+# Perl Bindings
+EXTRA_DIST += \
+	src/perl/.gitignore \
+	src/perl/Location.xs \
+	src/perl/MANIFEST \
+	src/perl/Makefile.PL \
+	src/perl/lib/Location.pm \
+	src/perl/t/Location.t \
+	src/perl/typemap
+
+.PHONY: build-perl
+build-perl:
+	@mkdir -p $(builddir)/src/perl/{lib,t}
+	@test -e $(builddir)/src/perl/Location.xs || ln -s --relative $(srcdir)/src/perl/Location.xs $(builddir)/src/perl/
+	@test -e $(builddir)/src/perl/MANIFEST || ln -s --relative $(srcdir)/src/perl/MANIFEST $(builddir)/src/perl/
+	@test -e $(builddir)/src/perl/Makefile.PL || ln -s --relative $(srcdir)/src/perl/Makefile.PL $(builddir)/src/perl/
+	@test -e $(builddir)/src/perl/lib/Location.pm || ln -s --relative $(srcdir)/src/perl/lib/Location.pm $(builddir)/src/perl/lib/
+	@test -e $(builddir)/src/perl/t/Location.t || ln -s --relative $(srcdir)/src/perl/t/Location.t $(builddir)/src/perl/t/
+	@test -e $(builddir)/src/perl/typemap || ln -s --relative $(srcdir)/src/perl/typemap $(builddir)/src/perl/
+
+	cd $(builddir)/src/perl && $(PERL) Makefile.PL PREFIX="$(prefix)" \
+		INC="-I$(abs_srcdir)/src" LIBS="-L$(abs_builddir)/src/.libs -lloc"
+	cd $(builddir)/src/perl && $(MAKE)
+
+.PHONY: check-perl
+check-perl: testdata.db
+	cd $(builddir)/src/perl && $(MAKE) test database="../../$<"
+
+.PHONY: install-perl
+install-perl:
+	cd $(builddir)/src/perl && $(MAKE) install
+
+.PHONY: clean-perl
+clean-perl:
+	cd $(builddir)/src/perl && $(MAKE) distclean
+
+.PHONY: uninstall-perl
+uninstall-perl:
+	rm -rvf \
+		$(DESTDIR)/$(prefix)/lib/*/perl/*/Location.pm \
+		$(DESTDIR)/$(prefix)/lib/*/perl/*/auto/Location \
+		$(DESTDIR)/$(prefix)/lib/*/perl/*/perllocal.pod \
+		$(DESTDIR)/$(prefix)/man/man3/Location.3pm
+
 bin_SCRIPTS = \
 	src/python/location-query
 
@@ -143,7 +199,11 @@ TESTS = \
 	src/test-network
 
 CLEANFILES += \
-	test.db
+	test.db \
+	testdata.db
+
+testdata.db: examples/python/create-database.py
+	PYTHONPATH=$(abs_builddir)/src/python/.libs $(PYTHON) $< $@
 
 check_PROGRAMS = \
 	src/test-libloc \

configure.ac

@@ -83,6 +83,15 @@ AC_SUBST([my_CFLAGS])
 AM_PATH_PYTHON([3.4])
 PKG_CHECK_MODULES([PYTHON], [python-${PYTHON_VERSION}])
 
+# Perl
+AC_PATH_PROG(PERL, perl, no)
+AC_SUBST(PERL)
+
+AX_PROG_PERL_MODULES(ExtUtils::MakeMaker,, AC_MSG_WARN(Need some Perl modules))
+
+AC_ARG_ENABLE(perl, AS_HELP_STRING([--disable-perl], [do not build the perl modules]), [],[enable_perl=yes])
+AM_CONDITIONAL(ENABLE_PERL, test "$enable_perl" = "yes")
+
 AC_CONFIG_HEADERS(config.h)
 AC_CONFIG_FILES([
         Makefile
@@ -104,4 +113,7 @@ AC_MSG_RESULT([
         ldflags:                ${LDFLAGS}
 
         debug:                  ${enable_debug}
+
+	Bindings:
+	  perl:			${enable_perl}
 ])

examples/python/create-database.py

 #!/usr/bin/python3
 
 import location
+import sys
 
 w = location.Writer()
 
@@ -10,6 +11,9 @@ w.vendor = "IPFire Project"
 # Set a description
 w.description = "This is a geo location database"
 
+# Set a license
+w.license = "CC"
+
 # Add an AS
 a = w.add_as(204867)
 a.name = "Lightning Wire Labs GmbH"
@@ -24,4 +28,5 @@ n.asn = a.number
 print(n)
 
 # Write the database to disk
-w.write("test.db")
+for f in sys.argv[1:]:
+    w.write(f)

m4/ax_prog_perl_modules.m4

+# ===========================================================================
+#   https://www.gnu.org/software/autoconf-archive/ax_prog_perl_modules.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_PROG_PERL_MODULES([MODULES], [ACTION-IF-TRUE], [ACTION-IF-FALSE])
+#
+# DESCRIPTION
+#
+#   Checks to see if the given perl modules are available. If true the shell
+#   commands in ACTION-IF-TRUE are executed. If not the shell commands in
+#   ACTION-IF-FALSE are run. Note if $PERL is not set (for example by
+#   calling AC_CHECK_PROG, or AC_PATH_PROG), AC_CHECK_PROG(PERL, perl, perl)
+#   will be run.
+#
+#   MODULES is a space separated list of module names. To check for a
+#   minimum version of a module, append the version number to the module
+#   name, separated by an equals sign.
+#
+#   Example:
+#
+#     AX_PROG_PERL_MODULES( Text::Wrap Net::LDAP=1.0.3, ,
+#                           AC_MSG_WARN(Need some Perl modules)
+#
+# LICENSE
+#
+#   Copyright (c) 2009 Dean Povey <povey@wedgetail.com>
+#
+#   Copying and distribution of this file, with or without modification, are
+#   permitted in any medium without royalty provided the copyright notice
+#   and this notice are preserved. This file is offered as-is, without any
+#   warranty.
+
+#serial 8
+
+AU_ALIAS([AC_PROG_PERL_MODULES], [AX_PROG_PERL_MODULES])
+AC_DEFUN([AX_PROG_PERL_MODULES],[dnl
+
+m4_define([ax_perl_modules])
+m4_foreach([ax_perl_module], m4_split(m4_normalize([$1])),
+	  [
+	   m4_append([ax_perl_modules],
+		     [']m4_bpatsubst(ax_perl_module,=,[ ])[' ])
+          ])
+
+# Make sure we have perl
+if test -z "$PERL"; then
+AC_CHECK_PROG(PERL,perl,perl)
+fi
+
+if test "x$PERL" != x; then
+  ax_perl_modules_failed=0
+  for ax_perl_module in ax_perl_modules; do
+    AC_MSG_CHECKING(for perl module $ax_perl_module)
+
+    # Would be nice to log result here, but can't rely on autoconf internals
+    $PERL -e "use $ax_perl_module; exit" > /dev/null 2>&1
+    if test $? -ne 0; then
+      AC_MSG_RESULT(no);
+      ax_perl_modules_failed=1
+   else
+      AC_MSG_RESULT(ok);
+    fi
+  done
+
+  # Run optional shell commands
+  if test "$ax_perl_modules_failed" = 0; then
+    :
+    $2
+  else
+    :
+    $3
+  fi
+else
+  AC_MSG_WARN(could not find perl)
+fi])dnl

src/database.c

@@ -323,6 +323,7 @@ static void loc_database_free(struct loc_database* db) {
 			ERROR(db->ctx, "Could not unmap network nodes section: %s\n", strerror(errno));
 	}
 
+	if (db->pool)
 		loc_stringpool_unref(db->pool);
 
 	loc_unref(db->ctx);

src/perl/.gitignore

+/Location.bs
+/Location.c
+/MYMETA.json
+/MYMETA.yml
+/blib
+/pm_to_blib

src/perl/Location.xs

+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <stdio.h>
+#include <string.h>
+
+
+#include <loc/libloc.h>
+#include <loc/database.h>
+#include <loc/network.h>
+
+
+MODULE = Location		PACKAGE = Location
+
+struct loc_database *
+init(file)
+	char* file;
+
+	CODE:
+		struct loc_ctx* ctx = NULL;
+
+		// Initialise location context
+		int err = loc_new(&ctx);
+		if (err < 0)
+			croak("Could not initialize libloc context: %d\n", err);
+
+		// Open the database file for reading
+		FILE* f = fopen(file, "r");
+		if (!f) {
+			loc_unref(ctx);
+
+			croak("Could not open file for reading: %s: %s\n",
+				file, strerror(errno));
+		}
+
+		// Parse the database
+		struct loc_database* db = NULL;
+		err = loc_database_new(ctx, &db, f);
+
+		// We can close the database file straight away
+		// because loc_database_new creates a copy of the file descriptor
+		fclose(f);
+
+		if (err) {
+			loc_unref(ctx);
+
+			croak("Could not read database: %s\n", file);
+		}
+
+		// Cleanup
+		loc_unref(ctx);
+
+		RETVAL = db;
+	OUTPUT:
+		RETVAL
+
+#
+# Database functions
+#
+const char*
+get_vendor(db)
+	struct loc_database* db;
+
+	CODE:
+		// Get vendor
+		RETVAL = loc_database_get_vendor(db);
+	OUTPUT:
+		RETVAL
+
+const char*
+get_description(db)
+	struct loc_database* db;
+
+	CODE:
+		// Get database description
+		RETVAL = loc_database_get_description(db);
+	OUTPUT:
+		RETVAL
+
+const char*
+get_license(db)
+	struct loc_database* db;
+
+	CODE:
+		// Get database license
+		RETVAL = loc_database_get_license(db);
+	OUTPUT:
+		RETVAL
+
+#
+# Lookup functions
+#
+SV*
+lookup_country_code(db, address)
+	struct loc_database* db;
+	char* address;
+
+	CODE:
+		RETVAL = &PL_sv_undef;
+
+		// Lookup network
+		struct loc_network *network;
+		int err = loc_database_lookup_from_string(db, address, &network);
+		if (!err) {
+			// Extract the country code
+			const char* country_code = loc_network_get_country_code(network);
+			RETVAL = newSVpv(country_code, strlen(country_code));
+
+			loc_network_unref(network);
+		}
+	OUTPUT:
+		RETVAL
+
+SV*
+lookup_asn(db, address)
+	struct loc_database* db;
+	char* address;
+
+	CODE:
+		RETVAL = &PL_sv_undef;
+
+		// Lookup network
+		struct loc_network *network;
+		int err = loc_database_lookup_from_string(db, address, &network);
+		if (!err) {
+			// Extract the ASN
+			unsigned int as_number = loc_network_get_asn(network);
+			if (as_number > 0) {
+				RETVAL = newSViv(as_number);
+			}
+
+			loc_network_unref(network);
+		}
+	OUTPUT:
+		RETVAL
+
+void
+DESTROY(db)
+	struct loc_database* db;
+
+	CODE:
+		// Close database
+		loc_database_unref(db);

src/perl/MANIFEST

+Location.xs
+Makefile.PL
+MANIFEST
+typemap
+t/Location.t
+lib/Location.pm

src/perl/Makefile.PL

+use 5.028001;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Location',
+    VERSION_FROM      => 'lib/Location.pm',
+    PREREQ_PM         => {},
+    ABSTRACT_FROM     => 'lib/Location.pm',
+    AUTHOR            => 'Stefan Schantl <stefan.schantl@ipfire.org>',
+    LICENSE           => 'lgpl',
+    LIBS              => ['-lloc'],
+    DEFINE            => '', # e.g., '-DHAVE_SOMETHING'
+    INC               => '-I. -I../../',
+	# Un-comment this if you add C files to link with later:
+    # OBJECT            => '$(O_FILES)', # link all the C files too
+);

src/perl/lib/Location.pm

+package Location;
+
+use 5.028001;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration	use Location ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw() ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw();
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Location', $VERSION);
+
+# Preloaded methods go here.
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Location - Provides a simple interface to libloc.
+
+=head1 SYNOPSIS
+
+  use Location;
+
+=head1 DESCRIPTION
+
+Location is a simple interface to libloc - A library to determine someones
+location on the Internet. (https://git.ipfire.org/?p=location/libloc.git;a=summary)
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+https://git.ipfire.org/?p=location/libloc.git;a=summary
+
+=head1 AUTHOR
+
+Stefan Schantl, stefan.schantl@ipfire.org
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2019 by Stefan Schantl
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.28.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut

src/perl/t/Location.t

+# Before 'make install' is performed this script should be runnable with
+# 'make test'. After 'make install' it should work as 'perl Location.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+# Where to find the test database.
+my $testdb = $ENV{'database'};
+
+use Test::More tests => 6;
+BEGIN { use_ok('Location') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+# Address which should be used for database lookup.
+my $address = "2a07:1c44:5800::1";
+
+# Connect to the database.
+my $db = &Location::init("$testdb");
+
+my $vendor = &Location::get_vendor($db);
+ok($vendor eq "IPFire Project", "Test 1 - Get Database Vendor");
+
+my $license = &Location::get_license($db);
+ok($license eq "CC", "Test 2 - Get Database license");
+
+my $description = &Location::get_description($db);
+ok($description eq "This is a geo location database", "Test 3 - Get Database Description");
+
+my $country_code = &Location::lookup_country_code($db, $address);
+ok($country_code eq "DE", "Test 4 - Lookup country code for $address");
+
+$country_code = &Location::lookup_country_code($db, "1.1.1.1");
+if(defined($country_code)) { fail("Test 5 - Lookup country code for address not in Database."); }
+
+$country_code = &Location::lookup_country_code($db, "a.b.c.d");
+if(defined($country_code)) { fail("Test 6 - Lookup country code for invalid address.") }
+
+my $as_number = &Location::lookup_asn($db, $address);
+ok($as_number eq "204867", "Test 7 - Lookup Autonomous System Number for $address.");
+
+$as_number = &Location::lookup_asn($db, "1.1.1.1");
+if(defined($as_number)) { fail("Test 8 - Lookup Autonomous System Number for address not in Database.") }
+
+$as_number = &Location::lookup_asn($db, "a.b.c.d");
+if(defined($as_number)) { fail("Test 9 - Lookup Autonomous System Number for invalid address.") }

src/perl/typemap

+TYPEMAP
+struct loc_database * T_PTRREF