imapsync-2.229-alt1.noarch	big-changelog	info	Package contains big ChangeLog. Gzip it.; 
imapsync-2.229-alt1.noarch	unsafe-tmp-usage-in-scripts	fail	The test discovered scripts with errors which may be used by a user for damaging important system files. For example if a script uses in its work a temp file which is created in /tmp directory, then every user can create symlinks with the same name (pattern) in this directory in order to destroy or rewrite some system or another user's files. Scripts _must_ _use_ mktemp/tempfile or must use $TMPDIR. mktemp/tempfile is safest. $TMPDIR is safer than /tmp/ because libpam-tmpdir creates a subdirectory of /tmp that is only accessible by that user, and then sets TMPDIR and other variables to that. Hence, it doesn't matter nearly as much if you create a non-random filename, because nobody but you can access it. Found error in /usr/bin/imapsync: $ grep /tmp/ /usr/bin/imapsync How do you know the sync is finished and well done? When imapsync ends by itself it mentions it with lines like those: Exiting with return value 0 (EX_OK: successful termination) 0/50 nb_errors/max_errors PID 301 Removing pidfile /tmp/imapsync.pid Log file is LOG_imapsync/2020_11_17_15_59_22_761_test1_test2.txt ( to change it, use filepath ; or use to turn off logging ) If you don't have those lines it means that either the sync process is still running (or eventually hanging indefinitely) or that it ended without a whisper, a strong kill on Linux for example. Readonly my $TRUE => 1 ; Readonly my $FALSE => 0 ; Readonly my $LAST_RESSORT_SEPARATOR => q{/} ; Readonly my $CGI_TMPDIR_TOP => '/var/tmp/imapsync_cgi' ; Readonly my $CGI_HASHFILE => '/var/tmp/imapsync_hash' ; Readonly my $UMASK_PARANO => '0077' ; Readonly my $STR_use_releasecheck => q{Check if a new imapsync release is available by adding --releasecheck} ; Readonly my $GMAIL_MAXSIZE => 35_651_584 ; -- output( $mysync, "No log by default in Docker context. Use --log to trigger logging to the logfile.\n" ) ; $mysync->{ log } = 0 ; } # In case something is written relatively to . my $tmp_dir = "/var/tmp/uid_$EFFECTIVE_USER_ID" ; mkpath( $tmp_dir ) ; # silly? No. it is for imapsync --version being ok. do_valid_directory( $tmp_dir ) ; output( $mysync, "Changing current directory to $tmp_dir\n" ) ; chdir $tmp_dir ; -- is( undef, loglogfile( $mysync ), 'loglogfile: undef => undef' ) ; $mysync->{ loglogfile } = 1 ; $mysync->{ log } = 1 ; is( undef, loglogfile( $mysync ), 'loglogfile: no logfile => undef' ) ; $mysync->{ logfile } = "logfile.txt" ; $mysync->{ loglogfilename } = "W/tmp/tests/list_all_logs_auto.txt" ; like( loglogfile( $mysync ), qr{logfile.txt}xms, 'loglogfile: logfile=logfile.txt => ' ) ; note( 'Leaving tests_loglogfile()' ) ; return ; } -- SKIP: { if ( 'MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) { skip( 'Tests only for non-root Unix', 1 ) ; } $mysync->{ hashfile } = '/rrr' ; is( undef, hashsynclocal( $mysync ), 'hashsynclocal: permission denied' ) ; } ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'hashsynclocal: mkpath W/tmp/tests/' ) ; $mysync->{ hashfile } = 'W/tmp/tests/imapsync_hash' ; ok( ! -e 'W/tmp/tests/imapsync_hash' || unlink 'W/tmp/tests/imapsync_hash', 'hashsynclocal: unlink W/tmp/tests/imapsync_hash' ) ; ok( ! -e 'W/tmp/tests/imapsync_hash', 'hashsynclocal: verify there is no W/tmp/tests/imapsync_hash' ) ; is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync, 'mukksyhpmbixkxkpjlqivmlqsulpictj' ), 'hashsynclocal: creating/reading W/tmp/tests/imapsync_hash' ) ; # A second time now is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync ), 'hashsynclocal: reading W/tmp/tests/imapsync_hash second time => same' ) ; note( 'Leaving tests_hashsynclocal()' ) ; return ; } -- sub tests_do_valid_directory { note( 'Entering tests_do_valid_directory()' ) ; is( 1, do_valid_directory( '.'), 'do_valid_directory: . good' ) ; is( 1, do_valid_directory( './W/tmp/tests/valid/sub'), 'do_valid_directory: ./W/tmp/tests/valid/sub good' ) ; Readonly my $NB_UNIX_tests_do_valid_directory_non_root => 2 ; diag( "OSNAME=$OSNAME EFFECTIVE_USER_ID=$EFFECTIVE_USER_ID" ) ; SKIP: { -- sub tests_remove_pidfile_not_running { note( 'Entering tests_remove_pidfile_not_running()' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'remove_pidfile_not_running: mkpath W/tmp/tests/' ) ; is( undef, remove_pidfile_not_running( ), 'remove_pidfile_not_running: no args => undef' ) ; is( undef, remove_pidfile_not_running( './W' ), 'remove_pidfile_not_running: a dir => undef' ) ; is( undef, remove_pidfile_not_running( 'noexists' ), 'remove_pidfile_not_running: noexists => undef' ) ; is( 1, touch( 'W/tmp/tests/empty.pid' ), 'remove_pidfile_not_running: prepa empty W/tmp/tests/empty.pid' ) ; is( undef, remove_pidfile_not_running( 'W/tmp/tests/empty.pid' ), 'remove_pidfile_not_running: W/tmp/tests/empty.pid => undef' ) ; is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/lalala.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/lalala.pid' ) ; is( undef, remove_pidfile_not_running( 'W/tmp/tests/lalala.pid' ), 'remove_pidfile_not_running: W/tmp/tests/lalala.pid => undef' ) ; is( '55555', string_to_file( '55555', 'W/tmp/tests/notrunning.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/notrunning.pid' ) ; is( 1, remove_pidfile_not_running( 'W/tmp/tests/notrunning.pid' ), 'remove_pidfile_not_running: W/tmp/tests/notrunning.pid => 1' ) ; is( $PROCESS_ID, string_to_file( $PROCESS_ID, 'W/tmp/tests/running.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/running.pid' ) ; is( undef, remove_pidfile_not_running( 'W/tmp/tests/running.pid' ), 'remove_pidfile_not_running: W/tmp/tests/running.pid => undef' ) ; note( 'Leaving tests_remove_pidfile_not_running()' ) ; return ; } -- sub tests_tail { note( 'Entering tests_tail()' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'tail: mkpath W/tmp/tests/' ) ; ok( ( ! -e 'W/tmp/tests/tail.pid' || unlink 'W/tmp/tests/tail.pid' ), 'tail: unlink W/tmp/tests/tail.pid' ) ; ok( ( ! -e 'W/tmp/tests/tail.txt' || unlink 'W/tmp/tests/tail.txt' ), 'tail: unlink W/tmp/tests/tail.txt' ) ; is( undef, tail( ), 'tail: no args => undef' ) ; my $mysync ; is( undef, tail( $mysync ), 'tail: no pidfile => undef' ) ; $mysync->{pidfile} = 'W/tmp/tests/tail.pid' ; is( undef, tail( $mysync ), 'tail: no pidfilelocking => undef' ) ; $mysync->{pidfilelocking} = 1 ; is( undef, tail( $mysync ), 'tail: pidfile no exists => undef' ) ; my $pidandlog = "33333\nW/tmp/tests/tail.txt\n" ; is( $pidandlog, string_to_file( $pidandlog, $mysync->{pidfile} ), 'tail: put pid 33333 and tail.txt in pidfile' ) ; is( undef, tail( $mysync ), 'tail: logfile to tail no exists => undef' ) ; my $tailcontent = "L1\nL2\nL3\nL4\nL5\n" ; is( $tailcontent, string_to_file( $tailcontent, 'W/tmp/tests/tail.txt' ), 'tail: put L1\nL2\nL3\nL4\nL5\n in W/tmp/tests/tail.txt' ) ; is( undef, tail( $mysync ), 'tail: fake pid in pidfile + tail off => 1' ) ; $mysync->{ tail } = 1 ; is( 1, tail( $mysync ), 'tail: fake pid in pidfile + tail on=> 1' ) ; # put my own pid, won't do tail $pidandlog = "$PROCESS_ID\nW/tmp/tests/tail.txt\n" ; is( $pidandlog, string_to_file( $pidandlog, $mysync->{pidfile} ), 'tail: put my own PID in pidfile' ) ; is( undef, tail( $mysync ), 'tail: my own pid in pidfile => undef' ) ; note( 'Leaving tests_tail()' ) ; return ; -- is( undef, write_pidfile( $mysync ), 'write_pidfile: no permission for /no/no/no.pid, no lock => undef' ) ; $mysync->{pidfilelocking} = 1 ; is( undef, write_pidfile( $mysync ), 'write_pidfile: no permission for /no/no/no.pid + lock => undef' ) ; $mysync->{pidfile} = 'W/tmp/tests/test.pid' ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'write_pidfile: mkpath W/tmp/tests/' ) ; is( 1, touch( $mysync->{pidfile} ), 'write_pidfile: lock prepa' ) ; $mysync->{pidfilelocking} = 0 ; is( 1, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + no lock => 1' ) ; is( $PROCESS_ID, firstline( 'W/tmp/tests/test.pid' ), "write_pidfile: W/tmp/tests/test.pid contains $PROCESS_ID" ) ; is( q{}, secondline( 'W/tmp/tests/test.pid' ), "write_pidfile: W/tmp/tests/test.pid contains no second line" ) ; $mysync->{pidfilelocking} = 1 ; is( undef, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + lock => undef' ) ; $mysync->{pidfilelocking} = 0 ; $mysync->{ logfile } = 'rrrr.txt' ; is( 1, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + no lock + logfile => 1' ) ; is( $PROCESS_ID, firstline( 'W/tmp/tests/test.pid' ), "write_pidfile: + no lock + logfile W/tmp/tests/test.pid contains $PROCESS_ID" ) ; is( q{rrrr.txt}, secondline( 'W/tmp/tests/test.pid' ), "write_pidfile: + no lock + logfile W/tmp/tests/test.pid contains rrrr.txt" ) ; note( 'Leaving tests_write_pidfile()' ) ; return ; } -- sub tests_get_cache { note( 'Entering tests_get_cache()' ) ; ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' ); ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' ) ), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ; ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ; my @test_files_cache = ( qw( W/tmp/cache/F1/F2/100_200 W/tmp/cache/F1/F2/101_201 W/tmp/cache/F1/F2/120_220 W/tmp/cache/F1/F2/142_242 W/tmp/cache/F1/F2/143_243 W/tmp/cache/F1/F2/177_277 W/tmp/cache/F1/F2/177_377 W/tmp/cache/F1/F2/177_777 W/tmp/cache/F1/F2/155_255 ) ) ; ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ; # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255 # on live: my $msgs_1 = [120, 142, 143, 144, 177 ]; -- my $msgs_all_1 = { 120 => 0, 142 => 0, 143 => 0, 144 => 0, 177 => 0 } ; my $msgs_all_2 = { 242 => 0, 243 => 0, 299 => 0, 377 => 0, 777 => 0, 255 => 0 } ; my( $c12, $c21 ) ; ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' ); my $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ; my $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ; ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' ); ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' ); ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200'); ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201'); # test clean_cache executed $maxage = 2 ; ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ; ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' ); ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242'); ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243'); ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200'); ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201'); # strange files #$debugcache = 1 ; $maxage = undef ; ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ; ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ; @test_files_cache = ( qw( W/tmp/cache/rr\uee/100_200 W/tmp/cache/rr\uee/101_201 W/tmp/cache/rr\uee/120_220 W/tmp/cache/rr\uee/142_242 W/tmp/cache/rr\uee/143_243 W/tmp/cache/rr\uee/177_277 W/tmp/cache/rr\uee/177_377 W/tmp/cache/rr\uee/177_777 W/tmp/cache/rr\uee/155_255 ) ) ; ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ; # on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255 # on live: $msgs_1 = [120, 142, 143, 144, 177 ] ; $msgs_2 = [ 242, 243, 299, 377, 777, 255 ] ; $msgs_all_1 = { 120 => q{}, 142 => q{}, 143 => q{}, 144 => q{}, 177 => q{} } ; $msgs_all_2 = { 242 => q{}, 243 => q{}, 299 => q{}, 377 => q{}, 777 => q{}, 255 => q{} } ; ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' ); $a1 = [ sort { $a <=> $b } keys %{ $c12 } ] ; $a2 = [ sort { $a <=> $b } keys %{ $c21 } ] ; ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' ); ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' ); ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242'); ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243'); ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200'); ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201'); note( 'Leaving tests_get_cache()' ) ; return ; } -- ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ; ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ; ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ; ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ; ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ; ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ; ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ; ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ; ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ; -- sub tests_clean_cache { note( 'Entering tests_clean_cache()' ) ; ok( ( not -d 'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ; ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ; my @test_files_cache = ( qw( W/tmp/cache/G1/G2/100_200 W/tmp/cache/G1/G2/101_201 W/tmp/cache/G1/G2/120_220 W/tmp/cache/G1/G2/142_242 W/tmp/cache/G1/G2/143_243 W/tmp/cache/G1/G2/177_277 W/tmp/cache/G1/G2/177_377 W/tmp/cache/G1/G2/177_777 W/tmp/cache/G1/G2/155_255 ) ) ; ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ; ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' ); ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' ); ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' ); ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' ); ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' ); ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' ); my $cache = { 142 => 242, 177 => 777, } ; -- 242 => q{}, 777 => q{}, } ; ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ; ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' ); ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' ); ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' ); ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' ); ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' ); ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' ); note( 'Leaving tests_clean_cache()' ) ; return ; } sub tests_clean_cache_2 { note( 'Entering tests_clean_cache_2()' ) ; ok( ( not -d 'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ; ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ; my @test_files_cache = ( qw( W/tmp/cache/G1/G2/100_200 W/tmp/cache/G1/G2/101_201 W/tmp/cache/G1/G2/120_220 W/tmp/cache/G1/G2/142_242 W/tmp/cache/G1/G2/143_243 W/tmp/cache/G1/G2/177_277 W/tmp/cache/G1/G2/177_377 W/tmp/cache/G1/G2/177_777 W/tmp/cache/G1/G2/155_255 ) ) ; ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ; ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' ); ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' ); ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' ); ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' ); ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' ); ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' ); my $cache = { 142 => 242, 177 => 777, } ; -- ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ; ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' ); ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' ); ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' ); ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' ); ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' ); ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' ); note( 'Leaving tests_clean_cache_2()' ) ; return ; } -- sub tests_mkpath { note( 'Entering tests_mkpath()' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' )), 'mkpath: mkpath W/tmp/tests/' ) ; SKIP: { skip( 'Tests only for Unix', 10 ) if ( 'MSWin32' eq $OSNAME ) ; my $long_path_unix = '123456789/' x 30 ; ok( ( -d "W/tmp/tests/long/$long_path_unix" or mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'mkpath: mkpath 300 char' ) ; ok( -d "W/tmp/tests/long/$long_path_unix", 'mkpath: mkpath > 300 char verified' ) ; ok( ( -d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'mkpath: rmtree 300 char' ) ; ok( ! -d "W/tmp/tests/long/$long_path_unix", 'mkpath: rmtree 300 char verified' ) ; ok( ( -d 'W/tmp/tests/trailing_dots...' or mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ; ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ; ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ; ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ; eval { ok( 1 / 0, 'mkpath: divide by 0' ) ; } or ok( 1, 'mkpath: can not divide by 0' ) ; ok( 1, 'mkpath: still alive' ) ; } ; -- eval { ok( ( -d $long_path_300 or mkpath( $long_path_300 ) ), 'mkpath: create a path with 300 characters' ) ; } or ok( 1, 'mkpath: can not create a path with 300 characters' ) ; ok( ( ( ! -d $long_path_300 ) or -d $long_path_300 and rmtree( $long_path_300 ) ), 'mkpath: rmtree the 300 character path' ) ; ok( 1, 'mkpath: still alive' ) ; ok( ( -d 'W/tmp/tests/trailing_dots...' or mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ; ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ; ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ; ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ; } ; note( 'Leaving tests_mkpath()' ) ; -- sub tests_touch { note( 'Entering tests_touch()' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' )), 'touch: mkpath W/tmp/tests/' ) ; ok( 1 == touch( 'W/tmp/tests/lala'), 'touch: W/tmp/tests/lala') ; ok( 1 == touch( 'W/tmp/tests/\y'), 'touch: W/tmp/tests/\y') ; ok( 0 == touch( '/no/no/no/aaa'), 'touch: not /aaa') ; ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'touch: 2 files') ; ok( 0 == touch( 'W/tmp/tests/\y', '/no/no/aaa'), 'touch: 2 files, 1 fails' ) ; note( 'Leaving tests_touch()' ) ; return ; } -- sub tests_firstline { note( 'Entering tests_firstline()' ) ; is( q{}, firstline( 'W/tmp/tests/noexist.txt' ), 'firstline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'firstline: mkpath W/tmp/tests/' ) ; is( "blabla\n" , string_to_file( "blabla\n", 'W/tmp/tests/firstline.txt' ), 'firstline: put blabla in W/tmp/tests/firstline.txt' ) ; is( 'blabla' , firstline( 'W/tmp/tests/firstline.txt' ), 'firstline: get blabla from W/tmp/tests/firstline.txt' ) ; is( q{} , string_to_file( q{}, 'W/tmp/tests/firstline2.txt' ), 'firstline: put empty string in W/tmp/tests/firstline2.txt' ) ; is( q{} , firstline( 'W/tmp/tests/firstline2.txt' ), 'firstline: get empty string from W/tmp/tests/firstline2.txt' ) ; is( "\n" , string_to_file( "\n", 'W/tmp/tests/firstline3.txt' ), 'firstline: put CR in W/tmp/tests/firstline3.txt' ) ; is( q{} , firstline( 'W/tmp/tests/firstline3.txt' ), 'firstline: get empty string from W/tmp/tests/firstline3.txt' ) ; is( "blabla\nTiti\n" , string_to_file( "blabla\nTiti\n", 'W/tmp/tests/firstline4.txt' ), 'firstline: put blabla\nTiti\n in W/tmp/tests/firstline4.txt' ) ; is( 'blabla' , firstline( 'W/tmp/tests/firstline4.txt' ), 'firstline: get blabla from W/tmp/tests/firstline4.txt' ) ; note( 'Leaving tests_firstline()' ) ; return ; } -- sub tests_secondline { note( 'Entering tests_secondline()' ) ; is( q{}, secondline( 'W/tmp/tests/noexist.txt' ), 'secondline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ; is( q{}, secondline( 'W/tmp/tests/noexist.txt', 2 ), 'secondline: 2nd getting empty string from inexisting W/tmp/tests/noexist.txt' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'secondline: mkpath W/tmp/tests/' ) ; is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/secondline.txt' ), 'secondline: put L1\nL2\nL3\nL4\n in W/tmp/tests/secondline.txt' ) ; is( 'L2' , secondline( 'W/tmp/tests/secondline.txt' ), 'secondline: get L2 from W/tmp/tests/secondline.txt' ) ; note( 'Leaving tests_secondline()' ) ; return ; } -- sub tests_nthline { note( 'Entering tests_nthline()' ) ; is( q{}, nthline( 'W/tmp/tests/noexist.txt' ), 'nthline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ; is( q{}, nthline( 'W/tmp/tests/noexist.txt', 2 ), 'nthline: 2nd getting empty string from inexisting W/tmp/tests/noexist.txt' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'nthline: mkpath W/tmp/tests/' ) ; is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/nthline.txt' ), 'nthline: put L1\nL2\nL3\nL4\n in W/tmp/tests/nthline.txt' ) ; is( 'L3' , nthline( 'W/tmp/tests/nthline.txt', 3 ), 'nthline: get L3 from W/tmp/tests/nthline.txt' ) ; note( 'Leaving tests_nthline()' ) ; return ; } -- is( undef, file_to_array( ), 'file_to_array: no args => undef' ) ; is( undef, file_to_array( '/noexist' ), 'file_to_array: /noexist => undef' ) ; is( undef, file_to_array( '/' ), 'file_to_array: reading a directory => undef' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'file_to_array: mkpath W/tmp/tests/' ) ; is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/file_to_array.txt' ), 'file_to_array: put L1\nL2\nL3\nL4\n in W/tmp/tests/file_to_array.txt' ) ; is_deeply( [ "L1\n", "L2\n", "L3\n", "L4\n" ] , [ file_to_array( 'W/tmp/tests/file_to_array.txt' ) ], 'file_to_array: get back L1\n L2\n L3\n L4\n from W/tmp/tests/file_to_array.txt' ) ; note( 'Leaving tests_file_to_array()' ) ; return ; } -- is( undef, file_to_string( ), 'file_to_string: no args => undef' ) ; is( undef, file_to_string( '/noexist' ), 'file_to_string: /noexist => undef' ) ; is( undef, file_to_string( '/' ), 'file_to_string: reading a directory => undef' ) ; ok( file_to_string( $PROGRAM_NAME ), 'file_to_string: reading myself' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'file_to_string: mkpath W/tmp/tests/' ) ; is( 'lilili', string_to_file( 'lilili', 'W/tmp/tests/canbewritten' ), 'file_to_string: string_to_file filling W/tmp/tests/canbewritten with lilili' ) ; is( 'lilili', file_to_string( 'W/tmp/tests/canbewritten' ), 'file_to_string: reading W/tmp/tests/canbewritten is lilili' ) ; is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'file_to_string: string_to_file filling W/tmp/tests/empty with empty string' ) ; is( q{}, file_to_string( 'W/tmp/tests/empty' ), 'file_to_string: reading W/tmp/tests/empty is empty' ) ; note( 'Leaving tests_file_to_string()' ) ; return ; } -- note( 'Entering tests_string_to_file()' ) ; is( undef, string_to_file( ), 'string_to_file: no args => undef' ) ; is( undef, string_to_file( 'lalala' ), 'string_to_file: one arg => undef' ) ; is( undef, string_to_file( 'lalala', '.' ), 'string_to_file: writing a directory => undef' ) ; ok( (-d 'W/tmp/tests/' or mkpath( 'W/tmp/tests/' ) ), 'string_to_file: mkpath W/tmp/tests/' ) ; is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/canbewritten' ), 'string_to_file: W/tmp/tests/canbewritten with lalala' ) ; is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'string_to_file: W/tmp/tests/empty with empty string' ) ; SKIP: { Readonly my $NB_UNX_tests_string_to_file => 1 ; skip( 'Not on Unix non-root', $NB_UNX_tests_string_to_file ) if ('MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) ; is( undef, string_to_file( 'lalala', '/cantouch' ), 'string_to_file: /cantouch denied => undef' ) ; -- return backtick( $command ) ; } sub search_dyn_lib_locale_linux { my $command = qq{ lsof -p $PROCESS_ID | grep ' REG ' | grep -v '/tmp/par-' | grep '\.so' } ; myprint( "Search non embeded dynamic libs with the command: $command\n" ) ; return backtick( $command ) ; } sub search_dyn_lib_locale_MSWin32 -- sub tests_logfileprepa { note( 'Entering tests_logfileprepa()' ) ; is( undef, logfileprepa( ), 'logfileprepa: no args => undef' ) ; my $logfile = 'W/tmp/tests/tests_logfileprepa.txt' ; is( 1, logfileprepa( $logfile ), 'logfileprepa: W/tmp/tests/tests_logfileprepa.txt => 1' ) ; note( 'Leaving tests_logfileprepa()' ) ; return ; } -- my $mysync = {} ; is( undef, teelaunch( $mysync ), 'teelaunch: arg empty {} => undef' ) ; is( undef, teelaunch( $mysync, '' ), 'teelaunch: empty string => undef' ) ; # First time, learning IO::Tee intrasics my $tee = teelaunch( $mysync, 'W/tmp/tests/tests_teelaunch.txt' ) ; isa_ok( $tee, 'IO::Tee', 'teelaunch: logfile W/tmp/tests/tests_teelaunch.txt' ) ; is( 1, print( $tee "Hi!\n" ), 'teelaunch: write Hi!') ; is( "Hi!\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is Hi!\n' ) ; is( 1, print( $tee "Hoo\n" ), 'teelaunch: write Hoo') ; is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is Hi!\nHoo\n' ) ; # closing file handle so tee won't be happy ($tee->handles)[0]->close ; is( undef, print( $tee "Argh1\n" ), 'teelaunch: write Argh1') ; is( undef, print( $tee "Argh2\n" ), 'teelaunch: write Argh2') ; # write not done is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is still Hi!\nHoo\n' ) ; print join( ' ', $tee->handles ), "\n"; is( 2, scalar $tee->handles, 'teelaunch: 2 handles') ; shift @{*{$tee}}; print join(' ', $tee->handles), "\n" ; is( 1, scalar $tee->handles, 'teelaunch: 1 handle') ; -- # will not print anything now is( 0, scalar $tee->handles, 'teelaunch: 0 handle') ; is( 1, print( $tee "Argh 4\n" ), 'teelaunch: write Argh4 no') ; # Second time, lesson learnt IO::Tee $tee = teelaunch( $mysync, 'W/tmp/tests/tests_teelaunch2.txt' ) ; isa_ok( $tee, 'IO::Tee' , 'teelaunch: W/tmp/tests/tests_teelaunch2.txt' ) ; is( 1, print( $tee "Hi!\n" ), 'teelaunch: write Hi!') ; is( "Hi!\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is Hi!\n' ) ; is( 1, print( $tee "Hoo\n" ), 'teelaunch: write Hoo') ; is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is Hi!\nHoo\n' ) ; is( 1, teefinish( $tee ), 'teefinish: return 1') ; is( 1, print( $tee "Argh1\n" ), 'teelaunch: write Argh1') ; is( 1, print( $tee "Argh2\n" ), 'teelaunch: write Argh2') ; is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch2.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch2.txt is still Hi!\nHoo\n' ) ; is( 1, teefinish( $tee ), 'teefinish: still return 1') ; note( 'Leaving tests_teelaunch()' ) ; return ; } -- my $mysync = { } ; is( undef, get_options_extra( $mysync ), 'get_options_extra: undef => undef' ) ; my $cwd_save = getcwd( ) ; ok( (-d 'W/tmp/tests/options_extra/' or mkpath( 'W/tmp/tests/options_extra/' )), 'get_options_extra: mkpath W/tmp/tests/options_extra/' ) ; chdir 'W/tmp/tests/options_extra/' ; is( '--debugimap1', string_to_file( '--debugimap1', 'options_extra.txt' ), 'get_options_extra: string_to_file filling options_extra.txt with --debugimap1' ) ; is( '--debugimap1', file_to_string( 'options_extra.txt' ), 'get_options_extra: reading options_extra.txt is --debugimap1' ) ; -- if ( ! $mysync->{ testsdebug } ) { skip 'No test in normal run' ; } note( 'Entering testsdebug()' ) ; #ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ; #tests_check_binary_embed_all_dyn_libs( ) ; #tests_killpid_by_parent( ) ; #tests_killpid_by_brother( ) ; #tests_kill_zero( ) ; #tests_connect_socket( ) ;;