Re: Return a 200 0K status and send the content of the request later

This is a multi-part message in MIME format.

--Multipart=_Fri__16_May_2025_01_11_48_+0200_kyPRWsC.d8Y8Mb6y
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: quoted-printable

On Tue, 13 May 2025 22:57:05 -0400
Ed Sabol <[email protected]> wrote:

Hi Ed,

>=20
> Well, the standard way of doing that is you fork a child process to run t=
he system command while the parent process loops and prints a period (or wh=
atever you prefer) every 1 second (make sure you call flush() after printin=
g!) while waiting for the child process to finish.=20

Indeed. As it happens, the Paris Perl Mongueurs (http://paris.mongueurs.net=
/) held their monthly meeting last Wednesday night, and I requested advice =
from the fine members of the club. They rapidly concluded that's what I sho=
uld do.

I have a working prototype, it's modeled after https://stackoverflow.com/qu=
estions/471681/how-do-i-fork-properly-with-mod-perl2/. The page prints the =
asterisks while the fork builds the tar file, and adds the summary with fil=
e_size, interval, etc... when it detects the file.

It probably needs some polishing, critics welcome. Excuse my French.

https://pastebin.com/wn2Cw5KF

(not sure what line 114 'warn "started\n" ;' is for, since all STDs are red=
irected to /dev/null?)

>Lots of good examples of this can be found here:
>=20
> https://stackoverflow.com/questions/3193091/showing-progress-whilst-runni=
ng-a-system-command-in-perl/
>=20

Thank you for this. Interesting answer with waitpid, but have not tested yet

> I also recommend that you still put an upper time limit on your subproces=
s and not just loop infinitely. 30 minutes to an hour seems like a reasonab=
le choice. Depends on how big your tar files can be, of course.

Gee, just when I thought I was done with this ;-) But you're right

--=20
					Bien =E0 vous, Vincent Veyron

https://legalcase.libremen.com
Open source legal case, contract and insurance claims management software


--Multipart=_Fri__16_May_2025_01_11_48_+0200_kyPRWsC.d8Y8Mb6y
Content-Type: text/x-perl;
 name="export_raw_data.pm"
Content-Disposition: attachment;
 filename="export_raw_data.pm"
Content-Transfer-Encoding: quoted-printable

package Marica::Base::Rapports::export_raw_data ;

use utf8 ;

use strict ;

use POSIX 'setsid';

use Time::HiRes qw(gettimeofday tv_interval);

use Apache2::Const -compile =3D> qw(OK REDIRECT) ;

sub handler {

    binmode(STDOUT, ":utf8") ;

    my $r =3D shift ;

    my $req =3D Apache2::Request->new($r) ;

    #r=C3=A9cup=C3=A9rer les arguments
    my ( %args, @args ) ;

    @args =3D $req->param ;

    for (@args) {

	$args{$_} =3D Encode::decode_utf8( $req->param($_) ) ;

	#nix those sql injection/htmlcode attacks!
	$args{$_} =3D~ tr/<>;/-/ ;

	#les double-quotes viennent interf=C3=A9rer avec le html
	$args{$_} =3D~ tr/"/'/ ;

    }

    my $id_client =3D $r->pnotes('session')->{id_client} ;

    my $content =3D '<h1 style=3D"text-align: center;">' . _( 'Exportation =
des donn=C3=A9es', $r ) . '</h1>' ;

    #nom du r=C3=A9pertoire de collecte des fichiers/donn=C3=A9es/documents=
 dans /base/listing
    my $token_id =3D map +(0..9,"a".."z","A".."Z")[rand(10+26*2)], 1..32 ;
   =20
    my $recipient_dir =3D $r->document_root() . '/base/listing/' . $r->pnot=
es('session')->{_session_id} ;

    my $result_file_name =3D  $r->pnotes('session')->{_session_id} ;

    my $final_file_name =3D '' ;

    #effacer les listings pr=C3=A9c=C3=A9dents de la session pour d=C3=A9ma=
rrer propre
    #il faut le faire avant de lancer le fork, sinon le test -e d=C3=A9tect=
e le fichier pr=C3=A9c=C3=A9dent encore pr=C3=A9sent
    $ENV{'PATH'} =3D '/bin:/usr/bin' ;

    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

    my @args =3D ( 'rm', '-r', $r->document_root() . '/base/listing/' . $r-=
>pnotes('session')->{_session_id} ) ;

    system(@args) =3D=3D 0 or warn "system @args failed: $?" ;

    my @args =3D ( 'rm', $r->document_root() . '/base/listing/' . $r->pnote=
s('session')->{_session_id} . '.tar.gz' ) ;

    system(@args) =3D=3D 0 or warn "system @args failed: $?" ;

    if ( defined $args{go_for_it} ) {
=09
	$ENV{'PATH'} =3D '/bin:/usr/bin' ;

	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

	$r->content_type('text/html; charset=3Dutf-8') ;

	$r->print('<!DOCTYPE html><html lang =3D "fr"><head><meta http-equiv=3D"Co=
ntent-Type" content=3D"text/html; charset=3Dutf-8"><title>' . $r->hostname =
. '</title></head><body><h3>Building tar file</h3><p>*') ;
=09
	$r->rflush ; #clear the request buffer

	my $t0 =3D [gettimeofday];
=09
	#on s=C3=A9lectionne la base qui va bien
	my @databases =3D $r->dir_config->get('db_name') ;
=09
	my $demo_user_name =3D $r->dir_config('demo_username') ;

	my $database =3D ( $r->pnotes('session')->{username} =3D~ /$demo_user_name=
/ ) ? $databases[1] : $databases[0] ;

	#on fait un fork pour lancer le long process
	#le fork cr=C3=A9e le .tar.gz =C3=A0 t=C3=A9l=C3=A9charger
	$SIG{CHLD} =3D 'IGNORE';
=09
	defined (my $kid =3D fork) or die "Cannot fork: $!\n" ;

	if ($kid) {
	   =20
	    #print "Parent $$ has finished, kid's PID: $kid\n" ;

	} else {

	    # chdir to '/' stops the process from preventing an unmount
	    chdir '/'                 or die "Can't chdir to /: $!" ;

	    open STDIN, '/dev/null'   or die "Can't read /dev/null: $!" ;

	    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!" ;

	    open STDERR, '>/tmp/log'  or die "Can't write to /tmp/log: $!" ;

	    setsid                    or die "Can't start a new session: $!" ;

	    my $oldfh =3D select STDERR ;

	    local $| =3D 1 ;

	    select $oldfh ;
#	    warn "started\n" ;

	    #cr=C3=A9er les r=C3=A9pertoires de stockage
	    mkdir $recipient_dir ;
	    mkdir '/tmp/marica_data' ;

	    #dump du sch=C3=A9ma de la base
	    my @args =3D ('pg_dump', '-s', '-f', $recipient_dir . '/marica.out', $=
database) ;

	    system(@args) =3D=3D 0 or warn "system @args failed: $?" ;

	    #la commande d'exportation des donn=C3=A9es du client ressemble =C3=A0=
 =C3=A7a:
	    #psql -f /home/lib/Marica/Base/Procedures/Reversibility/export_raw_dat=
a.sql -v id_client=3D13 -v database=3Dmarica postgres
	    #on cr=C3=A9e provisoirement les fichiers data dans /tmp/marica_data
	    @args =3D ('psql', '-f', '/home/lib/Marica/Base/Procedures/Reversibili=
ty/export_raw_data.sql', '-v', 'id_client=3D' . $r->pnotes('session')->{id_=
client}, '-v',  'database=3D' . $database, 'postgres') ;

	    system(@args) =3D=3D 0 or warn "system @args failed: $!" ;

	    #if faut les d=C3=A9placer dans $recipient_dir
	    @args =3D ('mv', '/tmp/marica_data', $recipient_dir . '/data') ;

	    system(@args) =3D=3D 0 or warn "system @args failed: $!" ;

	    #copier le fichier create_db.sh et remplacer =3Did_client par la bonne=
 valeur
	    my $id_client =3D $r->pnotes('session')->{id_client} ;

	    my $script ;

	    open (my $fh_in, "<:encoding(UTF-8)", '/home/lib/Marica/Base/Procedure=
s/Reversibility/create_db.sh') or die "Can't open create_db.sh : $!" ;

	    while ( <$fh_in> ) {

		$script .=3D $_;
	=09
	    }

	    $script =3D~ s/=3Did_client/=3D$id_client/ ;
	   =20
	    close $fh_in ;
	   =20
	    #cr=C3=A9ation du fichier pour le client
	    my $out_file =3D  $recipient_dir . '/create_db.sh' ;

	    open (my $fh_out, ">:encoding(UTF-8)", $out_file) or warn "Can't open =
$out_file : $!" ;

	    #ajouter le BOM pour que les tableurs s'ouvrent avec le bon encodage (=
utf8)
	    #on peut aussi utiliser chr(65279);
	    #MS-Office a besoin de =C3=A7a pour identifier l'encodage
	    print $fh_out chr(0xFEFF) ;

	    print $fh_out $script ;

	    close $fh_out ;
	   =20
	    #copier le fichier import_raw_data.sql
	    @args =3D ('cp', '/home/lib/Marica/Base/Procedures/Reversibility/impor=
t_raw_data.sql', $recipient_dir) ;

	    system(@args) =3D=3D 0 or warn "system @args failed: $!" ;

	    #cr=C3=A9ation du fichier tar compress=C3=A9
	    my $temp_name =3D $result_file_name . '.tmp' ;
	   =20
	    @args =3D ( 'tar', '-czf', $r->document_root() . '/base/listing/' . $t=
emp_name, $recipient_dir) ;

	    system(@args) =3D=3D 0 or warn "system @args failed: $!" ;

	    #renommer proprement le fichier tar pour d=C3=A9tection par la boucle =
do { }
	    $final_file_name =3D $result_file_name . '.tar.gz' ;

	    rename $r->document_root() . '/base/listing/' . $temp_name , $r->docum=
ent_root() . '/base/listing/' . $final_file_name ;

	    CORE::exit(0); # terminate the process

	} #	if ($kid)=20

	#pendant que le fork travaille, on v=C3=A9rifie si le fichier .tar.gz fina=
l existe
	#tant qu'il n'est pas pr=C3=A9sent, on envoie un nouvel =C3=A9l=C3=A9ment =
toutes les secondes
	my $i =3D 1 ;
=09
	do {

	    my $final_result =3D $r->document_root() . '/base/listing/' . $result_=
file_name . '.tar.gz' ;

	    $i =3D 0 if -e $final_result ;
	   =20
	    $r->print('*') ;

	    $r->rflush; #clear the request buffer

	    sleep( 1 ) ;
	   =20
	} while ( $i ) ;

	$r->print( '</p>' ) ;
=09
	$r->rflush; #clear the request buffer
=09
	my $t1 =3D [gettimeofday] ;

	my $t0_t1 =3D tv_interval $t0, $t1 ;

	my $file_size =3D -s $r->document_root() . '/base/listing/' . $result_file=
_name . '.tar.gz' ;

	$content =3D '<pre>
using db : ' . $database . '
recipient_dir : ' . $recipient_dir . '
file size : ' . $file_size . '=20
interval : ' . $t0_t1 . '
    </pre>' ;

	my $download_link =3D '<a href=3D"/base/listing/' . $result_file_name . '.=
tar.gz">T=C3=A9l=C3=A9charger ' . $result_file_name . '.tar.gz</a>' ;
=09
	my $download_zone =3D '
<h3>Lien</h3>
<p>' . $download_link . '
</p></body>' ;

	$content .=3D $download_zone ;
=09
	$r->print( $content ) ;

	return Apache2::Const::OK ;

    } else {

	$content .=3D presentation($r) ;

    } #    if ( defined $args{go_for_it} )

    $r->content_type('text/html; charset=3Dutf-8') ;

    $r->no_cache(1) ;

    print $content ;

    return Apache2::Const::OK ;
   =20
}

1 ;


sub presentation {

    my $r =3D shift ;

    my $content =3D '<h2>Instructions</h2>' ;

    $content .=3D '<p>Cette proc=C3=A9dure cr=C3=A9e un fichier contenant t=
outes les donn=C3=A9es stock=C3=A9es dans la base pour votre compte</p>' ;

    $content .=3D '<p>Ce fichier est une archive tar contenant :</p>' ;

    $content .=3D '
<ul>
<li>le fichier create_db.sh qui cr=C3=A9e la base de donn=C3=A9es Postgresq=
l pour accueillir les donn=C3=A9es (nomm=C3=A9e "import_raw_data")</li>
<li>le fichier marica.out contenant le schema de la base de donn=C3=A9es</l=
i>
<li>le fichier import.sql qui importe les donn=C3=A9es</li>
<li>le r=C3=A9pertoire data qui contient les donn=C3=A9es (s=C3=A9parateur =
de donn=C3=A9es "TAB")</li>
</ul>' ;

    $content .=3D '<h3>Utilisation</h3>
<ul>
<li>Cr=C3=A9er le r=C3=A9pertoire /tmp/marica</li>
<li>Extraire de l\'archive tar les 4 =C3=A9l=C3=A9ments ci-dessus, et les p=
lacer dans /tmp/marica </li>
<li>Rendre create_db.sh executable</li>
<li>Executer create_db.sh en tant que super-utilisateur</li>
</ul>' ;

   =20
    my $form =3D '
<form action=3Dexport_raw_data method=3DPOST>
<p><input type=3Dsubmit value=3D"Exporter les donn=C3=A9es"><input type=3Dh=
idden name=3Dgo_for_it value=3D0></p>
</form>
    ' ; =20

    $content .=3D $form ;
   =20
    return $content ;
   =20

} #sub presentation


--Multipart=_Fri__16_May_2025_01_11_48_+0200_kyPRWsC.d8Y8Mb6y--