diff options
| -rwxr-xr-x | net-setup.pl | 851 | ||||
| -rw-r--r-- | t/99-versioning.t | 18 |
2 files changed, 16 insertions, 853 deletions
diff --git a/net-setup.pl b/net-setup.pl deleted file mode 100755 index ca2c16ac..00000000 --- a/net-setup.pl +++ /dev/null @@ -1,851 +0,0 @@ -#!/usr/bin/perl -# -###################################################################### -# LedgerSMB Small Medium Business Accounting Software Installer -# http://www.ledgersmb.org/ -# - -# Copyright (C) 2006 -# This work contains copyrighted information from a number of sources all used -# with permission. -# -# This file contains source code included with or based on SQL-Ledger which -# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed -# under the GNU General Public License version 2 or, at your option, any later -# version. For a full list including contact information of contributors, -# maintainers, and copyright holders, see the CONTRIBUTORS file. -# -# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): -# Copyright (c) 2002, Dieter Simader -# -# Web: http://www.sql-ledger.org -# -####################################################################### - -# Next bunch of lines are to check to see if they have the cpan module installed. -my $cpan = 0; -eval { use CPAN; }; -if ( !$@ ) { - $cpan = 1; -} - -$| = 1; - -#not sure how safe this is. If the browser sends a blank GATEWAY_INTERFACE -#will this script destroy part of the install? -#This script should probably be made inaccessible via HTTP until this feature is working -if ( ( $ENV{GATEWAY_INTERFACE} ) || ( $ENV{HTTP_HOST} ) ) { - print -"Content-type: text/html\n\nThis does not work yet! use $0 from the command line"; - exit; -} - -# Make sure they have the required perl modules installed. -# bin/mozilla/admin.pl needs Digest::MD5 for session handling -# HTML:LinkExtor is used by the setup program. -my @req_modules = (qw(DBI DBD::Pg Digest::MD5 HTML::LinkExtor)); - -foreach my $module (@req_modules) { - print "Checking for: $module ...\t"; - my @results = &check_module($module); - print "$results[1]\n"; - next if ( $results[0] ); # Passed, no need to continue.. - if ( $cpan == 1 ) { - - # Can try to install the module.. - print -"\n\nWould you like to try and install this package ($module) through CPAN? (Y/N) [Y]:"; - my $response = <STDIN>; - if ( ( $response =~ /y/i ) or ( $response eq "\n" ) ) { - my $inst_obj = CPAN::Shell->install($module); - @results = &check_module($module); - if ( !$results[0] ) { - print "\n\nCould not install $module using CPAN.\n"; - die "Please try to install this module manually\n"; - } - } - else { - die "Please install the $module perl module and retry the setup.\n"; - } - } - else { - - # Can't try to install the module.. - die "Please install the $module perl module and retry the setup.\n"; - } -} - -use HTML::LinkExtor; - -my $lynx = `lynx -version`; # if LWP is not installed use lynx -my $gzip = `gzip -V 2>&1`; # gz decompression utility -my $tar = `tar --version 2>&1`; # tar archiver -my $latex = `latex -version`; - -my $versionurl = 'http://prdownloads.sourceforge.net/ledger-smb'; - -my %source = ( - 1 => { - url => "http://voxel.dl.sourceforge.net/sourceforge/ledger-smb", - site => "New York, U.S.A", - locale => 'us' - }, - 2 => { - url => "http://easynews.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Arizona, U.S.A", - locale => 'us' - }, - 3 => { - url => "http://ufpr.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Brazil", - locale => 'br' - }, - 4 => { - url => "http://surfnet.dl.sourceforge.net/sourceforge/ledger-smb", - site => "The Netherlands", - locale => 'nl' - }, - 5 => { - url => "http://http://kent.dl.sourceforge.net/sourceforge/ledger-smb", - site => "U.K", - locale => 'uk' - }, - 6 => { - url => "http://ovh.dl.sourceforge.net/sourceforge/ledger-smb", - site => "France", - locale => 'fr' - }, - 7 => { - url => "http://mesh.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Germany", - locale => 'de' - }, - 8 => { - url => "http://citkit.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Russia", - locale => 'ru' - }, - 9 => { - url => "http://optusnet.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Sydney, Australia", - locale => 'au' - }, - 10 => { - url => "http://nchc.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Taiwan", - locale => 'tw' - }, - 11 => { - url => "http://jaist.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Japan", - locale => 'jp' - }, - 12 => { - url => "http://heanet.dl.sourceforge.net/sourceforge/ledger-smb", - site => "Ireland", - locale => 'ie' - } -); - -my $userspath = "users"; # default for new installation - -eval { require "ledger-smb.conf"; }; - -my $filename = shift; -chomp $filename; - -my $newinstall = 1; - -# is LWP installed -eval { require LWP::Simple; }; -$lwp = !($@); - -unless ( $lwp || $lynx || $filename ) { - die "You must have either lynx or LWP installed or specify a filename. -perl $0 <filename>\n"; -} - -if ($filename) { - - # extract version - die "Not a Ledger-SMB archive\n" if ( $filename !~ /^ledger-smb/ ); - $version = $filename; - $version =~ s/ledger-smb-(\d+\.\d+\.\d+).*$/$1/; - -} - -if ( -f "VERSION" ) { - - # get installed version from VERSION file - open( FH, '<', "VERSION" ); - @a = <FH>; - close(FH); - $version = $a[0]; - chomp $version; - $newinstall = !$version; - if ( !-f "ledger-smb.conf" ) { - $newinstall = 1; - } -} - -# Try to determine web user and group.. - -$webowner = "nobody"; -$webgroup = "nogroup"; - -# Check for apache2.conf -if ( $httpd = `find /etc /usr/local/etc -type f -name 'apache2.conf'` ) { - chomp $httpd; - $webowner = `grep "^User " $httpd`; - $webgroup = `grep "^Group " $httpd`; - chomp $webowner; - chomp $webgroup; - ( undef, $webowner ) = split / /, $webowner; - ( undef, $webgroup ) = split / /, $webgroup; - -} -elsif ( $httpd = `find /etc /usr/local/etc -type f -name 'httpd.conf'` ) { - - # Else check for httpd.conf - chomp $httpd; - $webowner = `grep "^User " $httpd`; - $webgroup = `grep "^Group " $httpd`; - chomp $webowner; - chomp $webgroup; - ( undef, $webowner ) = split / /, $webowner; - ( undef, $webgroup ) = split / /, $webgroup; -} - -if ( $confd = `find /etc /usr/local/etc -type d -name 'apache*/conf.d'` ) { - chomp $confd; -} - -# If we are doing a new install.. check the postgresql installation.. -if ( $newinstall == 1 ) { - - # Check the postgresql version before we even check for a connection if local - system("tput clear"); # Clear the screen.. - our ( $pghost, $pgport, $pguser, $pgpassword ); - print -"\n\nIs PostgreSQL installed [L]ocally,\n or will you be connecting to a [R]emote server? (L/R) [L]:"; - my $localremote = <STDIN>; - if ( ( $localremote =~ /L/i ) or ( $localremote eq "\n" ) ) { - $pghost = 'localhost'; - - # If local, check the local postgresql version.. - my $pgversion = `psql --version`; - ($pgversionnum) = $pgversion =~ m/(\d\.\d\.\d)/; - unless ( $pgversionnum gt '8.0.0' ) { - - # Die, cannot continue.. - print -"LedgerSMB requires postgres version 8.0 or higher. You have version $pgversionnum installed\n"; - die; - } - } - if ( !&check_pgconnect ) { - print "\n\n\nInstallation was not successful\n Exiting....\n"; - exit; - } - -} - -system("tput clear"); - -if ($filename) { - $install = "\ninstall $version from (f)ile\n"; -} - -# check for latest version -&get_latest_version; -chomp $latest_version; - -if ( !$newinstall ) { - - $install .= "\n(r)einstall $version\n"; - -} - -if ( $version && $latest_version ) { - if ( $version ne $latest_version ) { - $install .= "\n(u)pgrade to $latest_version\n"; - } -} - -$install .= "\n(i)nstall $latest_version (from Internet)\n" if $latest_version; - -$install .= "\n(d)ownload $latest_version (no installation)" unless $filename; - -print qq| - - - LedgerSMB Accounting and ERP Installation - - - -$install - - -Enter: |; - -$a = <STDIN>; -chomp $a; - -exit unless $a; -$a = lc $a; - -if ( $a !~ /d/ ) { - - print qq|\nEnter httpd owner [$webowner] : |; - $web = <STDIN>; - chomp $web; - $webowner = $web if $web; - - print qq|\nEnter httpd group [$webgroup] : |; - $web = <STDIN>; - chomp $web; - $webgroup = $web if $web; - -} - -if ( $a ne 'f' ) { - system("tput clear"); - - # choose site - foreach $item ( sort { $a <=> $b } keys %source ) { - $i++; - print qq|$i. $source{$item}{site}\n|; - } - - $site = "1"; - - print qq|\nChoose Location [$site] : |; - $b = <STDIN>; - chomp $b; - $site = $b if $b; -} - -if ( $a eq 'd' ) { - &download; -} -if ( $a =~ /(i|u)/ ) { - &install_smb; -} -if ( $a eq 'r' ) { - $latest_version = $version; - &install_smb; -} -if ( $a eq 'f' ) { - &install_smb; -} - -exit; - -# end main - -sub check_module { - my ($module) = @_; - eval "use $module"; - if ( !$@ ) { - return 1, "Ok"; - } - else { - return 0, "FAILED", $@; - } -} - -sub download { - - &get_source_code; - -} - -sub get_latest_version { - - print "Checking for latest version number .... "; - - if ($filename) { - print "skipping, filename supplied\n"; - return; - } - my $urlresult = ''; - if ($lwp) { - if ( $urlresult = LWP::Simple::get("$versionurl") ) { - $latest_version = parse_links($urlresult); - } - else { - print "not found"; - } - } - else { - if ( !$lynx ) { - print "\nYou must have either lynx or LWP installed"; - exit 1; - } - $ok = `lynx -dump -head $versionurl`; - if ( $ok = ( $ok =~ s/HTTP.*?200 // ) ) { - $urlresult = `lynx -dump $versionurl`; - $latest_version = parse_links($urlresult); - } - else { - print "not found"; - } - die unless $ok; - } - - if ($latest_version) { - print "ok\n"; - 1; - } - -} - -my @versions = (); - -sub parse_links { - - # Take the html retrieved by lwp or lynx and look for the version numbers. - my $text = shift; - my $version = ''; - my $p = HTML::LinkExtor->new( \&cb ); - $p->parse($text) or die; - foreach (@versions) { - my ($chkversion) = - $_ =~ - /^\/ledger-smb\/ledger-smb-(\d{1,3}\.\d{1,3}\.\d{1,3}\w*)\.tar\.gz$/; - $version = $chkversion if ( $chkversion gt $version ); - } - return $version; -} - -sub cb { - - # Callback function for LinkExtor - my ( $tag, %attr ) = @_; - return if $tag ne 'a'; - return - unless $attr{href} =~ - /^\/ledger-smb\/ledger-smb-\d{1,3}\.\d{1,3}\.\d{1,3}\w*\.tar\.gz$/; - push( @versions, values %attr ); - -} - -sub get_source_code { - - $err = 0; - - @order = (); - push @order, $site; - - for ( sort { $a <=> $b } keys %source ) { - push @order, $_; - } - - if ($latest_version) { - - # download it - chomp $latest_version; - $latest_version = "ledger-smb-${latest_version}.tar.gz"; - - print "\nStatus\n"; - print "Downloading $latest_version .... "; - - foreach $key (@order) { - print "\n$source{$key}{site} .... "; - - if ($lwp) { - $err = - LWP::Simple::getstore( "$source{$key}{url}/$latest_version", - "$latest_version" ); - $err -= 200; - } - else { - $ok = `lynx -dump -head $source{$key}{url}/$latest_version`; - $err = !( $ok =~ s/HTTP.*?200 // ); - - if ( !$err ) { - $err = - system( -"lynx -dump $source{$key}{url}/$latest_version > $latest_version" - ); - } - } - - if ($err) { - print "failed!"; - } - else { - last; - } - - } - - } - else { - $err = -1; - } - - if ($err) { - die "Cannot get $latest_version"; - } - else { - print "ok!\n"; - } - - $latest_version; - -} - -sub install_smb { - - if ($filename) { - $latest_version = $filename; - } - else { - $latest_version = &get_source_code; - } - - &decompress; - - if ($newinstall) { - open( FH, '<', "ledger-smb.conf.default" ); - @f = <FH>; - close(FH); - unless ($latex) { - grep { s/^\$latex.*/\$latex = 0;/ } @f; - } - open( FH, '>', "ledger-smb.conf" ); - print FH @f; - close(FH); - - $alias = $absolutealias = $ENV{'PWD'}; - $alias =~ s/.*\///g; - - $httpddir = `dirname $httpd`; - if ($confd) { - $httpddir = $confd; - } - chomp $httpddir; - $filename = "ledger-smb-httpd.conf"; - - # do we have write permission? - if ( !open( FH, '>>', "$httpddir/$filename" ) ) { - open( FH, '>', "$filename" ); - $norw = 1; - } - - open( HTTPD, '<', 'sql-ledger-httpd.conf' ); - while ( $line = <HTTPD> ) { - print FH $line; - } - close(FH); - - print qq| -This is a new installation. - -|; - - if ($norw) { - print qq| -Webserver directives were written to $filename - -Copy $filename to $httpddir -|; - - if ( !$confd ) { - print qq| and add -# Ledger-SMB -Include $httpddir/$filename - -to $httpd -|; - } - - print qq| and restart your webserver!\n|; - - if ( !$permset ) { - print qq| -WARNING: permissions for templates, users, css and spool directory -could not be set. Login as root and set permissions - -# chown -hR :$webgroup users templates css spool -# chmod 771 users templates css spool - -|; - } - - } - else { - - print qq| -Webserver directives were written to - - $httpddir/$filename -|; - - if ( !$confd ) { - if ( !(`grep "^# LedgerSMB" $httpd`) ) { - - open( FH, '>>', "$httpd" ); - - print FH qq| - -# LedgerSMB -Include $httpddir/$filename -|; - close(FH); - - } - } - - if ( !$> ) { - - # send SIGHUP to httpd - if ( $f = `find /var -type f -name 'httpd.pid'` ) { - $pid = `cat $f`; - chomp $pid; - if ($pid) { - system("kill -s HUP $pid"); - } - } - } - } - } - - # if this is not root, check if user is part of $webgroup - if ($>) { - if ( $permset = ( $) =~ getgrnam $webgroup ) ) { - `chown -hR :$webgroup users templates css spool`; - chmod 0771, 'users', 'templates', 'css', 'spool'; - `chown :$webgroup ledger-smb.conf`; - } - } - else { - - # root - `chown -hR 0:0 *`; - `chown -hR $webowner:$webgroup users templates css spool`; - chmod 0771, 'users', 'templates', 'css', 'spool'; - `chown $webowner:$webgroup ledger-smb.conf`; - } - - chmod 0644, 'ledger-smb.conf'; - unlink "ledger-smb.conf.default"; - - &cleanup; - - while ( $a !~ /(Y|N)/ ) { - print qq|\nDisplay README (Y/n) : |; - $a = <STDIN>; - chomp $a; - $a = ($a) ? uc $a : 'Y'; - - if ( $a eq 'Y' ) { - @args = ( "more", "doc/README" ); - system(@args); - } - } - -} - -sub decompress { - - die "Error: gzip not installed\n" unless ($gzip); - die "Error: tar not installed\n" unless ($tar); - - &create_lockfile; - - # ungzip and extract source code - print "Decompressing $latest_version ... "; - - if ( system("gzip -df $latest_version") ) { - print "Error: Could not decompress $latest_version\n"; - &remove_lockfile; - exit; - } - else { - print "done\n"; - } - - # strip gz from latest_version - $latest_version =~ s/\.gz//; - - # now untar it - print "Unpacking $latest_version ... "; - if ( system("tar -xf $latest_version") ) { - print "Error: Could not unpack $latest_version\n"; - &remove_lockfile; - exit; - } - else { - - # now we have a copy in ledger-smb - if ( system("tar -cf $latest_version -C ledger-smb .") ) { - print "Error: Could not create archive for $latest_version\n"; - &remove_lockfile; - exit; - } - else { - if ( system("tar -xf $latest_version") ) { - print "Error: Could not unpack $latest_version\n"; - &remove_lockfile; - exit; - } - else { - print "done\n"; - print "cleaning up ... "; - `rm -rf ledger-smb`; - print "done\n"; - } - } - } -} - -sub create_lockfile { - - if ( -d "$userspath" ) { - open( FH, '>', "$userspath/nologin" ); - close(FH); - } - -} - -sub cleanup { - - unlink "$latest_version"; - unlink "$userspath/members.default" if ( -f "$userspath/members.default" ); - - &remove_lockfile; - -} - -sub remove_lockfile { - unlink "$userspath/nologin" - if ( -f "$userspath/nologin" ); -} - -sub check_pgconnect { - print -"We will now attempt to validate that we are able to \nconnect to your postgres database.\n"; - my $cnx = 0; - while ( !$cnx ) { - print "\nPlease enter the host name of the postgresql database? " - . "(ie localhost)\n [$pghost]:"; - my $response = <STDIN>; - $response =~ s/\s*//g; - chomp($response); - -# Should probably try to validate the hostname here.. but for now, we'll leave it. - $response = $pghost if ( $response eq '' ); - while ( !$pgport ) { - print "\nPlease enter the port postgres is listening on.\n[5432]:"; - $pgport = <STDIN>; - chomp($pgport); - $pgport = 5432 if ( $pgport eq '' ); - if ( ( $pgport =~ /\D/ ) || ( $pgport > 65535 ) ) { - print "\nThe port must be a number between 0 and 65535, " - . "postgres default is 5432\n"; - undef $pgport; - } - } - while ( !$pguser ) { - print "\nPlease enter a valid postgres user name " - . "to validate the connection.:"; - $pguser = <STDIN>; - chomp($pguser); - if ( $pguser eq '' ) { - print "\nYou must enter a username\n"; - } - } - while ( !$pgpass ) { - print "\nPlease enter a valid postgres password " - . "to validate the connection.:"; - $pgpass = <STDIN>; - chomp($pgpass); - if ( $pgpass eq '' ) { - print "\nYou must enter a password\n"; - } - } - - # Try to connect; - eval { - my $dbh = - DBI->connect( - "dbi:Pg:dbname=template1;host=$response;" . "port=$pgport;", - $pguser, $pgpass ) - or die $DBI::errstr; - my $version = $dbh->get_info(18); - if ( $version =~ /^07/ ) { - die "You have postgres version $version installed, " - . "we require a minimum of 8.0\n"; - } - $dbh->{pg_enable_utf8} = 1; - }; - if ($@) { - system("tput clear"); - print "Connection to the database was unsucessful\n" - . "The error we received was this:\n$@\n" - . "Would you like to try to enter the authentication " - . "information again? (Y/N)[N]:"; - $answer = <STDIN>; - chomp($answer); - if ( $answer =~ /n/i ) { - $cnx = 1; - } - } - else { - $cnx = 1; - } - } - - # Try to guide the user to an answer to the connection problems. - system("tput clear"); # Clear the screen.. - print "Have you already set up a database user for LedgerSMB? (Y/N) [N]:"; - $answer = <STDIN>; - chomp($answer); - if ( ( $answer =~ /n/i ) or ( $answer eq "" ) ) { - print q| - -If you have not set up a database user yet, you can use the following command: - -# su postgres -$ createuser -d ledger-smb -Shall the new user be allowed to create databases? (y/n) y -Shall the new user be allowed to create more new users? (y/n) n - -if you use passwords to access postgres use this command -$ createuser -d -P ledger-smb - |; - return 0; - } - - # Maybe they did not change pg_hba.conf? - print qq|Did you modify pg_hba.conf to allow access? - - See pg_hba.conf example entries here: - http://www.postgresql.org/docs/8.0/static/client-authentication.html#EXAMPLE-PG-HBA.CONF - A good starting point would be to add something similar to below to pg_hba.conf: - host all all 192.168.1.5/32 MD5 - Which would allow a connection - from any user, - to any database, - from that one IP (You will need to change this for your setup) - Using a MD5 password. - - Also, remember to reload postgres when you make the change. - - Did you allow access to the postgres database from the web server? - (Y/N) [Y]:|; - $answer = <STDIN>; - if ( ( $response =~ /n/i ) or ( $response eq "\n" ) ) { - return 0; - } - - # Add other checks here.. - - return 0; -} -print "\nConnection Successful, Press enter to continue\n"; -$answer = <STDIN>; -return 1; - diff --git a/t/99-versioning.t b/t/99-versioning.t index d7ce0126..e760daee 100644 --- a/t/99-versioning.t +++ b/t/99-versioning.t @@ -27,6 +27,20 @@ is($form->{version}, $ver, 'Form version matches VERSION'); SKIP: { skip 'Form is trunk', 1 if $form->{version} =~ /trunk$/i; - cmp_ok($form->{version}, 'ge', $form->{dbversion}, - 'form: version >= dbversion'); + my @dparts = split /\./, $form->{dbversion}; + my @lparts = split /\./, $form->{version}; + my $age = 0; + foreach my $dpart (@dparts) { + my $lpart = shift @lparts; + if (!defined $lpart) { + $age = 1; + last; + } elsif ($lpart > $dpart) { + last; + } elsif ($dpart > $lpart) { + $age = 1; + last; + } + } + ok($age == 0, 'form: version >= dbversion'); } |