#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 2016 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
# Scan symbols-in-version (which is verified to be correct by test 1119), then
# verify that each option mention in there that should have its own man page
# actually does.
#
# In addition, make sure that every current option to curl_easy_setopt,
# curl_easy_getinfo and curl_multi_setopt are also mentioned in their
# corresponding main (index) man page.
#
# src/tool_getparam.c lists all options curl can parse
# docs/curl.1 documents all command line options
# src/tool_listhelp.c outputs all options with curl -h
# - make sure they're all in sync
#
# Output all deviances to stderr.

use strict;
use warnings;

# we may get the dir roots pointed out
my $root=$ARGV[0] || ".";
my $buildroot=$ARGV[1] || ".";
my $syms = "$root/docs/libcurl/symbols-in-versions";
my $curlh = "$root/include/curl/curl.h";
my $errors=0;

# the prepopulated alias list is the CURLINFO_* defines that are used for the
# debug function callback and the fact that they use the same prefix as the
# curl_easy_getinfo options was a mistake.
my %alias = (
    'CURLINFO_DATA_IN' => 'none',
    'CURLINFO_DATA_OUT' => 'none',
    'CURLINFO_END' => 'none',
    'CURLINFO_HEADER_IN' => 'none',
    'CURLINFO_HEADER_OUT' => 'none',
    'CURLINFO_LASTONE' => 'none',
    'CURLINFO_NONE' => 'none',
    'CURLINFO_SSL_DATA_IN' => 'none',
    'CURLINFO_SSL_DATA_OUT' => 'none',
    'CURLINFO_TEXT' => 'none'
    );

sub scanmanpage {
    my ($file, @words) = @_;

    open(M, "<$file");
    my @m;
    while(<M>) {
        if($_ =~ /^\.IP (.*)/) {
            my $w = $1;
            # "unquote" minuses
            $w =~ s/\\-/-/g;
            push @m, $w;
        }
    }
    close(M);

    foreach my $m (@words) {
        my @g = grep(/$m/, @m);
        if(!$g[0]) {
            print STDERR "Missing mention of $m in $file\n";
            $errors++;
        }
    }
}

# check for define alises
open(R, "<$curlh") ||
    die "no curl.h";
while(<R>) {
    if(/^\#define (CURL(OPT|INFO|MOPT)_\w+) (.*)/) {
        $alias{$1}=$3;
    }
}
close(R);

my @curlopt;
my @curlinfo;
my @curlmopt;
open(R, "<$syms") ||
    die "no input file";
while(<R>) {
    chomp;
    my $l= $_;
    if($l =~ /(CURL(OPT|INFO|MOPT)_\w+) *([0-9.]*) *([0-9.-]*) *([0-9.]*)/) {
        my ($opt, $type, $add, $dep, $rem) = ($1, $2, $3, $4, $5);

        if($alias{$opt}) {
            #print "$opt => $alias{$opt}\n";
        }
        elsif($rem) {
            # $opt was removed in $rem
            # so don't check for that
        }
        else {
            if($type eq "OPT") {
                push @curlopt, $opt,
            }
            elsif($type eq "INFO") {
                push @curlinfo, $opt,
            }
            elsif($type eq "MOPT") {
                push @curlmopt, $opt,
            }
            if(! -f "$root/docs/libcurl/opts/$opt.3") {
                print STDERR "Missing $opt.3\n";
                $errors++;
            }
        }
    }
}
close(R);

scanmanpage("$root/docs/libcurl/curl_easy_setopt.3", @curlopt);
scanmanpage("$root/docs/libcurl/curl_easy_getinfo.3", @curlinfo);
scanmanpage("$root/docs/libcurl/curl_multi_setopt.3", @curlmopt);

# using this hash array, we can skip specific options
my %opts = (
    # pretend these --no options exists in tool_getparam.c
    '--no-alpn' => 1,
    '--no-npn' => 1,
    '-N, --no-buffer' => 1,
    '--no-sessionid' => 1,
    '--no-keepalive' => 1,
    '--no-progress-meter' => 1,

    # pretend these options without -no exist in curl.1 and tool_listhelp.c
    '--alpn' => 6,
    '--npn' => 6,
    '--eprt' => 6,
    '--epsv' => 6,
    '--keepalive' => 6,
    '-N, --buffer' => 6,
    '--sessionid' => 6,
    '--progress-meter' => 6,

    # deprecated options do not need to be in tool_listhelp.c nor curl.1
    '--krb4' => 6,
    '--ftp-ssl' => 6,
    '--ftp-ssl-reqd' => 6,

    # for tests and debug only, can remain hidden
    '--test-event' => 6,
    '--wdebug' => 6,
    );

#########################################################################
# parse the curl code that parses the command line arguments!
open(R, "<$root/src/tool_getparam.c") ||
    die "no input file";
my $list;
my @getparam; # store all parsed parameters

while(<R>) {
    chomp;
    my $l= $_;
    if(/struct LongShort aliases/) {
        $list=1;
    }
    elsif($list) {
        if( /^  \{([^,]*), *([^ ]*)/) {
            my ($s, $l)=($1, $2);
            my $sh;
            my $lo;
            my $title;
            if($l =~ /\"(.*)\"/) {
                # long option
                $lo = $1;
                $title="--$lo";
            }
            if($s =~ /\"(.)\"/) {
                # a short option
                $sh = $1;
                $title="-$sh, $title";
            }
            push @getparam, $title;
            $opts{$title} |= 1;
        }
    }
}
close(R);

#########################################################################
# parse the curl.1 man page, extract all documented command line options
# The man page may or may not be rebuilt, so check both possible locations
open(R, "<$buildroot/docs/curl.1") || open(R, "<$root/docs/curl.1") ||
    die "no input file";
my @manpage; # store all parsed parameters
while(<R>) {
    chomp;
    my $l= $_;
    $l =~ s/\\-/-/g;
    if($l =~ /^\.IP \"(-[^\"]*)\"/) {
        my $str = $1;
        my $combo;
        if($str =~ /^-(.), --([a-z0-9.-]*)/) {
            # figure out the -short, --long combo
            $combo = "-$1, --$2";
        }
        elsif($str =~ /^--([a-z0-9.-]*)/) {
            # figure out the --long name
            $combo = "--$1";
        }
        if($combo) {
            push @manpage, $combo;
            $opts{$combo} |= 2;
        }
    }
}
close(R);

#########################################################################
# parse the curl code that outputs the curl -h list
open(R, "<$root/src/tool_listhelp.c") ||
    die "no input file";
my @toolhelp; # store all parsed parameters
while(<R>) {
    chomp;
    my $l= $_;
    if(/^  \{\" *(.*)/) {
        my $str=$1;
        my $combo;
        if($str =~ /^-(.), --([a-z0-9.-]*)/) {
            # figure out the -short, --long combo
            $combo = "-$1, --$2";
        }
        elsif($str =~ /^--([a-z0-9.-]*)/) {
            # figure out the --long name
            $combo = "--$1";
        }
        if($combo) {
            push @toolhelp, $combo;
            $opts{$combo} |= 4;
        }

    }
}
close(R);

#
# Now we have three arrays with options to cross-reference.

foreach my $o (keys %opts) {
    my $where = $opts{$o};

    if($where != 7) {
        # this is not in all three places
        $errors++;
        my $exists;
        my $missing;
        if($where & 1) {
            $exists=" tool_getparam.c";
        }
        else {
            $missing=" tool_getparam.c";
        }
        if($where & 2) {
            $exists.= " curl.1";
        }
        else {
            $missing.= " curl.1";
        }
        if($where & 4) {
            $exists .= " tool_listhelp.c";
        }
        else {
            $missing .= " tool_listhelp.c";
        }

        print STDERR "$o is not in$missing (but in$exists)\n";
    }
}

print STDERR "$errors\n";


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 2019 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
# Scan man page(s) and detect some simple and yet common formatting mistakes.
#
# Output all deviances to stderr.

use strict;
use warnings;

# get the file name first
my $symbolsinversions=shift @ARGV;

# we may get the dir roots pointed out
my @manpages=@ARGV;
my $errors = 0;

my %optblessed;
my %funcblessed;
my @optorder = (
    'NAME',
    'SYNOPSIS',
    'DESCRIPTION',
     #'DEFAULT', # CURLINFO_ has no default
    'PROTOCOLS',
    'EXAMPLE',
    'AVAILABILITY',
    'RETURN VALUE',
    'SEE ALSO'
    );
my @funcorder = (
    'NAME',
    'SYNOPSIS',
    'DESCRIPTION',
    'EXAMPLE',
    'AVAILABILITY',
    'RETURN VALUE',
    'SEE ALSO'
    );
my %shline; # section => line number

my %symbol;
sub allsymbols {
    open(F, "<$symbolsinversions") ||
        die "$symbolsinversions: $|";
    while(<F>) {
        if($_ =~ /^([^ ]*)/) {
            $symbol{$1}=$1;
        }
    }
    close(F);
}

sub scanmanpage {
    my ($file) = @_;
    my $reqex = 0;
    my $inex = 0;
    my $exsize = 0;
    my $shc = 0;
    my $optpage = 0; # option or function
    my @sh;

    open(M, "<$file") || die "no such file: $file";
    if($file =~ /[\/\\](CURL|curl_)[^\/\\]*.3/) {
        # This is the man page for an libcurl option. It requires an example!
        $reqex = 1;
        if($1 eq "CURL") {
            $optpage = 1;
        }
    }
    my $line = 1;
    while(<M>) {
        chomp;
        if($_ =~ /^.so /) {
            # this man page is just a referral
            close(M);
            return;
        }
        if($_ =~ /^\.SH EXAMPLE/i) {
            $inex = 1;
        }
        elsif($_ =~ /^\.SH/i) {
            $inex = 0;
        }
        elsif($inex)  {
            $exsize++;
            if($_ =~ /[^\\]\\n/) {
                print STDERR "$file:$line '\\n' need to be '\\\\n'!\n";
            }
        }
        if($_ =~ /^\.SH ([^\r\n]*)/i) {
            my $n = $1;
            # remove enclosing quotes
            $n =~ s/\"(.*)\"\z/$1/;
            push @sh, $n;
            $shline{$n} = $line;
        }

        if($_ =~ /^\'/) {
            print STDERR "$file:$line line starts with single quote!\n";
            $errors++;
        }
        if($_ =~ /\\f([BI])(.*)/) {
            my ($format, $rest) = ($1, $2);
            if($rest !~ /\\fP/) {
                print STDERR "$file:$line missing \\f${format} terminator!\n";
                $errors++;
            }
        }
        if($_ =~ /[ \t]+$/) {
            print STDERR "$file:$line trailing whitespace\n";
            $errors++;
        }
        if($_ =~ /\\f([BI])([^\\]*)\\fP/) {
            my $r = $2;
            if($r =~ /^(CURL.*)\(3\)/) {
                my $rr = $1;
                if(!$symbol{$rr}) {
                    print STDERR "$file:$line link to non-libcurl option $rr!\n";
                    $errors++;
                }
            }
        }
        $line++;
    }
    close(M);

    if($reqex) {
        # only for libcurl options man-pages

        my $shcount = scalar(@sh); # before @sh gets shifted
        if($exsize < 2) {
            print STDERR "$file:$line missing EXAMPLE section\n";
            $errors++;
        }

        if($shcount < 3) {
            print STDERR "$file:$line too few man page sections!\n";
            $errors++;
            return;
        }

        my $got = "start";
        my $i = 0;
        my $shused = 1;
        my @shorig = @sh;
        my @order = $optpage ? @optorder : @funcorder;
        my $blessed = $optpage ? \%optblessed : \%funcblessed;

        while($got) {
            my $finesh;
            $got = shift(@sh);
            if($got) {
                if($$blessed{$got}) {
                    $i = $$blessed{$got};
                    $finesh = $got; # a mandatory one
                }
            }
            if($i && defined($finesh)) {
                # mandatory section

                if($i != $shused) {
                    printf STDERR "$file:%u Got %s, when %s was expected\n",
                        $shline{$finesh},
                        $finesh,
                        $order[$shused-1];
                    $errors++;
                    return;
                }
                $shused++;
                if($i == scalar(@order)) {
                    # last mandatory one, exit
                    last;
                }
            }
        }

        if($i != scalar(@order)) {
            printf STDERR "$file:$line missing mandatory section: %s\n",
                $order[$i];
            printf STDERR "$file:$line section found at index %u: '%s'\n",
                $i, $shorig[$i];
            printf STDERR " Found %u used sections\n", $shcount;
            $errors++;
        }
    }
}

allsymbols();

if(!$symbol{'CURLALTSVC_H1'}) {
    print STDERR "didn't get the symbols-in-version!\n";
    exit;
}

my $ind = 1;
for my $s (@optorder) {
    $optblessed{$s} = $ind++
}
$ind = 1;
for my $s (@funcorder) {
    $funcblessed{$s} = $ind++
}

for my $m (@manpages) {
    scanmanpage($m);
}

print STDERR "ok\n" if(!$errors);

exit $errors;


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 2010 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
# This script scans C source files. If they seem to use memory functions,
# it also makes sure that it #includes the correct two header files!
#
# You can also mark a C source as fine by using 'mem-include-scan' anywhere in
# it.
#

use strict;
use warnings;

my $dir = $ARGV[0] || die "specify directory!";

sub scanfile {
    my ($file) = @_;
    my $memfunc;
    my $memdebug;
    my $curlmem;

    print STDERR "checking $file...\n";

    open(F, "<$file");
    while(<F>) {
        if($_ =~ /\W(free|alloc|strdup)\(/) {
            $memfunc++;
        }
        elsif($_ =~ /^ *# *include \"memdebug.h\"/) {
            $memdebug++;
        }
        elsif($_ =~ /^ *# *include \"curl_memory.h\"/) {
            $curlmem++;
        }
        elsif($_ =~ /mem-include-scan/) {
            # free pass
            close(F);
            return 0;
        }
        if($memfunc && $memdebug && $curlmem) {
            last;
        }
    }
    close(F);

    if($memfunc) {
        if($memdebug && $curlmem) {
            return 0;
        }
        else {
            if(!$memdebug) {
                print STDERR "$file doesn't include \"memdebug.h\"!\n";
            }
            if(!$curlmem) {
                print STDERR "$file doesn't include \"curl_memory.h\"!\n";
            }
            return 1;
        }
    }
    return 0;
}

opendir(my $dh, $dir) || die "can't opendir $dir: $!";
my @cfiles = grep { /\.c\z/ && -f "$dir/$_" } readdir($dh);
closedir $dh;

my $errs;
for(@cfiles) {
    $errs += scanfile("$dir/$_");
}

if($errs) {
    print STDERR "----\n$errs errors detected!\n";
    exit 2;
}


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
# Example input:
#
# MEM mprintf.c:1094 malloc(32) = e5718
# MEM mprintf.c:1103 realloc(e5718, 64) = e6118
# MEM sendf.c:232 free(f6520)

my $mallocs=0;
my $callocs=0;
my $reallocs=0;
my $strdups=0;
my $wcsdups=0;
my $showlimit;
my $sends=0;
my $recvs=0;
my $sockets=0;

while(1) {
    if($ARGV[0] eq "-v") {
        $verbose=1;
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-t") {
        $trace=1;
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-l") {
        # only show what alloc that caused a memlimit failure
        $showlimit=1;
        shift @ARGV;
    }
    else {
        last;
    }
}

my $maxmem;

sub newtotal {
    my ($newtot)=@_;
    # count a max here

    if($newtot > $maxmem) {
        $maxmem= $newtot;
    }
}

my $file = $ARGV[0];

if(! -f $file) {
    print "Usage: memanalyze.pl [options] <dump file>\n",
    "Options:\n",
    " -l  memlimit failure displayed\n",
    " -v  Verbose\n",
    " -t  Trace\n";
    exit;
}

open(FILE, "<$file");

if($showlimit) {
    while(<FILE>) {
        if(/^LIMIT.*memlimit$/) {
            print $_;
            last;
        }
    }
    close(FILE);
    exit;
}

my $lnum=0;
while(<FILE>) {
    chomp $_;
    $line = $_;
    $lnum++;
    if($line =~ /^LIMIT ([^ ]*):(\d*) (.*)/) {
        # new memory limit test prefix
        my $i = $3;
        my ($source, $linenum) = ($1, $2);
        if($trace && ($i =~ /([^ ]*) reached memlimit/)) {
            print "LIMIT: $1 returned error at $source:$linenum\n";
        }
    }
    elsif($line =~ /^MEM ([^ ]*):(\d*) (.*)/) {
        # generic match for the filename+linenumber
        $source = $1;
        $linenum = $2;
        $function = $3;

        if($function =~ /free\((\(nil\)|0x([0-9a-f]*))/) {
            $addr = $2;
            if($1 eq "(nil)") {
                ; # do nothing when free(NULL)
            }
            elsif(!exists $sizeataddr{$addr}) {
                print "FREE ERROR: No memory allocated: $line\n";
            }
            elsif(-1 == $sizeataddr{$addr}) {
                print "FREE ERROR: Memory freed twice: $line\n";
                print "FREE ERROR: Previously freed at: ".$getmem{$addr}."\n";
            }
            else {
                $totalmem -= $sizeataddr{$addr};
                if($trace) {
                    print "FREE: malloc at ".$getmem{$addr}." is freed again at $source:$linenum\n";
                    printf("FREE: %d bytes freed, left allocated: $totalmem bytes\n", $sizeataddr{$addr});
                }

                newtotal($totalmem);
                $frees++;

                $sizeataddr{$addr}=-1; # set -1 to mark as freed
                $getmem{$addr}="$source:$linenum";

            }
        }
        elsif($function =~ /malloc\((\d*)\) = 0x([0-9a-f]*)/) {
            $size = $1;
            $addr = $2;

            if($sizeataddr{$addr}>0) {
                # this means weeeeeirdo
                print "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n";
                print "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n";
            }

            $sizeataddr{$addr}=$size;
            $totalmem += $size;

            if($trace) {
                print "MALLOC: malloc($size) at $source:$linenum",
                " makes totally $totalmem bytes\n";
            }

            newtotal($totalmem);
            $mallocs++;

            $getmem{$addr}="$source:$linenum";
        }
        elsif($function =~ /calloc\((\d*),(\d*)\) = 0x([0-9a-f]*)/) {
            $size = $1*$2;
            $addr = $3;

            $arg1 = $1;
            $arg2 = $2;

            if($sizeataddr{$addr}>0) {
                # this means weeeeeirdo
                print "Mixed debug compile, rebuild curl now\n";
            }

            $sizeataddr{$addr}=$size;
            $totalmem += $size;

            if($trace) {
                print "CALLOC: calloc($arg1,$arg2) at $source:$linenum",
                " makes totally $totalmem bytes\n";
            }

            newtotal($totalmem);
            $callocs++;

            $getmem{$addr}="$source:$linenum";
        }
        elsif($function =~ /realloc\((\(nil\)|0x([0-9a-f]*)), (\d*)\) = 0x([0-9a-f]*)/) {
            my ($oldaddr, $newsize, $newaddr) = ($2, $3, $4);

            $totalmem -= $sizeataddr{$oldaddr};
            if($trace) {
                printf("REALLOC: %d less bytes and ", $sizeataddr{$oldaddr});
            }
            $sizeataddr{$oldaddr}=0;

            $totalmem += $newsize;
            $sizeataddr{$newaddr}=$newsize;

            if($trace) {
                printf("%d more bytes ($source:$linenum)\n", $newsize);
            }

            newtotal($totalmem);
            $reallocs++;

            $getmem{$oldaddr}="";
            $getmem{$newaddr}="$source:$linenum";
        }
        elsif($function =~ /strdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
            # strdup(a5b50) (8) = df7c0

            $dup = $1;
            $size = $2;
            $addr = $3;
            $getmem{$addr}="$source:$linenum";
            $sizeataddr{$addr}=$size;

            $totalmem += $size;

            if($trace) {
                printf("STRDUP: $size bytes at %s, makes totally: %d bytes\n",
                       $getmem{$addr}, $totalmem);
            }

            newtotal($totalmem);
            $strdups++;
        }
        elsif($function =~ /wcsdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
            # wcsdup(a5b50) (8) = df7c0

            $dup = $1;
            $size = $2;
            $addr = $3;
            $getmem{$addr}="$source:$linenum";
            $sizeataddr{$addr}=$size;

            $totalmem += $size;

            if($trace) {
                printf("WCSDUP: $size bytes at %s, makes totally: %d bytes\n",
                       $getmem{$addr}, $totalmem);
            }

            newtotal($totalmem);
            $wcsdups++;
        }
        else {
            print "Not recognized input line: $function\n";
        }
    }
    # FD url.c:1282 socket() = 5
    elsif($_ =~ /^FD ([^ ]*):(\d*) (.*)/) {
        # generic match for the filename+linenumber
        $source = $1;
        $linenum = $2;
        $function = $3;

        if($function =~ /socket\(\) = (\d*)/) {
            $filedes{$1}=1;
            $getfile{$1}="$source:$linenum";
            $openfile++;
            $sockets++; # number of socket() calls
        }
        elsif($function =~ /socketpair\(\) = (\d*) (\d*)/) {
            $filedes{$1}=1;
            $getfile{$1}="$source:$linenum";
            $openfile++;
            $filedes{$2}=1;
            $getfile{$2}="$source:$linenum";
            $openfile++;
        }
        elsif($function =~ /accept\(\) = (\d*)/) {
            $filedes{$1}=1;
            $getfile{$1}="$source:$linenum";
            $openfile++;
        }
        elsif($function =~ /sclose\((\d*)\)/) {
            if($filedes{$1} != 1) {
                print "Close without open: $line\n";
            }
            else {
                $filedes{$1}=0; # closed now
                $openfile--;
            }
        }
    }
    # FILE url.c:1282 fopen("blabla") = 0x5ddd
    elsif($_ =~ /^FILE ([^ ]*):(\d*) (.*)/) {
        # generic match for the filename+linenumber
        $source = $1;
        $linenum = $2;
        $function = $3;

        if($function =~ /f[d]*open\(\"(.*)\",\"([^\"]*)\"\) = (\(nil\)|0x([0-9a-f]*))/) {
            if($3 eq "(nil)") {
                ;
            }
            else {
                $fopen{$4}=1;
                $fopenfile{$4}="$source:$linenum";
                $fopens++;
            }
        }
        # fclose(0x1026c8)
        elsif($function =~ /fclose\(0x([0-9a-f]*)\)/) {
            if(!$fopen{$1}) {
                print "fclose() without fopen(): $line\n";
            }
            else {
                $fopen{$1}=0;
                $fopens--;
            }
        }
    }
    # GETNAME url.c:1901 getnameinfo()
    elsif($_ =~ /^GETNAME ([^ ]*):(\d*) (.*)/) {
        # not much to do
    }
    # SEND url.c:1901 send(83) = 83
    elsif($_ =~ /^SEND ([^ ]*):(\d*) (.*)/) {
        $sends++;
    }
    # RECV url.c:1901 recv(102400) = 256
    elsif($_ =~ /^RECV ([^ ]*):(\d*) (.*)/) {
        $recvs++;
    }

    # ADDR url.c:1282 getaddrinfo() = 0x5ddd
    elsif($_ =~ /^ADDR ([^ ]*):(\d*) (.*)/) {
        # generic match for the filename+linenumber
        $source = $1;
        $linenum = $2;
        $function = $3;

        if($function =~ /getaddrinfo\(\) = (\(nil\)|0x([0-9a-f]*))/) {
            my $add = $2;
            if($add eq "(nil)") {
                ;
            }
            else {
                $addrinfo{$add}=1;
                $addrinfofile{$add}="$source:$linenum";
                $addrinfos++;
            }
            if($trace) {
                printf("GETADDRINFO ($source:$linenum)\n");
            }
        }
        # fclose(0x1026c8)
        elsif($function =~ /freeaddrinfo\(0x([0-9a-f]*)\)/) {
            if(!$addrinfo{$1}) {
                print "freeaddrinfo() without getaddrinfo(): $line\n";
            }
            else {
                $addrinfo{$1}=0;
                $addrinfos--;
            }
            if($trace) {
                printf("FREEADDRINFO ($source:$linenum)\n");
            }
        }

    }
    else {
        print "Not recognized prefix line: $line\n";
    }
}
close(FILE);

if($totalmem) {
    print "Leak detected: memory still allocated: $totalmem bytes\n";

    for(keys %sizeataddr) {
        $addr = $_;
        $size = $sizeataddr{$addr};
        if($size > 0) {
            print "At $addr, there's $size bytes.\n";
            print " allocated by ".$getmem{$addr}."\n";
        }
    }
}

if($openfile) {
    for(keys %filedes) {
        if($filedes{$_} == 1) {
            print "Open file descriptor created at ".$getfile{$_}."\n";
        }
    }
}

if($fopens) {
    print "Open FILE handles left at:\n";
    for(keys %fopen) {
        if($fopen{$_} == 1) {
            print "fopen() called at ".$fopenfile{$_}."\n";
        }
    }
}

if($addrinfos) {
    print "IPv6-style name resolve data left at:\n";
    for(keys %addrinfofile) {
        if($addrinfo{$_} == 1) {
            print "getaddrinfo() called at ".$addrinfofile{$_}."\n";
        }
    }
}

if($verbose) {
    print "Mallocs: $mallocs\n",
        "Reallocs: $reallocs\n",
        "Callocs: $callocs\n",
        "Strdups:  $strdups\n",
        "Wcsdups:  $wcsdups\n",
        "Frees: $frees\n",
        "Sends: $sends\n",
        "Recvs: $recvs\n",
        "Sockets: $sockets\n",
        "Allocations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups)."\n",
        "Operations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups + $sends + $recvs + $sockets)."\n";

    print "Maximum allocated: $maxmem\n";
}


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 2016 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
# scan nroff pages to find basic syntactic problems such as unbalanced \f
# codes or references to non-existing curl man pages.

my $docsroot = $ARGV[0];

if(!$docsroot || ($docsroot eq "-g")) {
    print "Usage: nroff-scan.pl <docs root dir> [nroff files]\n";
    exit;
}

shift @ARGV;

my @f = @ARGV;

my %manp;

sub manpresent {
    my ($man) = @_;
    if($manp{$man}) {
        return 1;
    }
    elsif(-r "$docsroot/$man" ||
          -r "$docsroot/libcurl/$man" ||
          -r "$docsroot/libcurl/opts/$man") {
        $manp{$man}=1;
        return 1;
    }
    return 0;
}

sub file {
    my ($f) = @_;
    open(F, "<$f") ||
        die "no file";
    my $line = 1;
    while(<F>) {
        chomp;
        my $l = $_;
        while($l =~ s/\\f(.)([^ ]*)\\f(.)//) {
            my ($pre, $str, $post)=($1, $2, $3);
            if($post ne "P") {
                print "error: $f:$line: missing \\fP after $str\n";
                $errors++;
            }
            if($str =~ /((libcurl|curl)([^ ]*))\(3\)/i) {
                my $man = "$1.3";
                if(!manpresent($man)) {
                    print "error: $f:$line: referring to non-existing man page $man\n";
                    $errors++;
                }
                if($pre ne "I") {
                    print "error: $f:$line: use \\fI before $str\n";
                    $errors++;
                }
            }
        }
        if($l =~ /(curl([^ ]*)\(3\))/i) {
            print "error: $f:$line: non-referencing $1\n";
            $errors++;
        }
        if($l =~ /^\.BR (.*)/) {
            my $i= $1;
            while($i =~ s/((lib|)curl([^ ]*)) *\"\(3\)(,|) *\" *//i ) {
                my $man = "$1.3";
                if(!manpresent($man)) {
                    print "error: $f:$line: referring to non-existing man page $man\n";
                    $errors++;
                }
            }
        }
        $line++;
    }
    close(F);
}

foreach my $f (@f) {
    file($f);
}

print "OK\n" if(!$errors);

exit $errors?1:0;


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 2010 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
###########################################################################
#
#
# - Get all options mentioned in the $cmddir.
# - Make sure they're all mentioned in the $opts document
# - Make usre that the version in $opts matches the version in the file in
#   $cmddir
#

my $opts = $ARGV[0];
my $cmddir = $ARGV[1];

sub cmdfiles {
    my ($dir)=@_;

    opendir(my $dh, $dir) || die "Can't opendir $dir: $!";
    my @opts = grep { /\.d$/ && -f "$dir/$_" } readdir($dh);
    closedir $dh;

    for(@opts) {
        $_ =~ s/\.d$//;
        $file{$_}=1;
    }
    return @opts;
}

sub mentions {
    my ($f) = @_;
    my @options;
    open(F, "<$f");
    while(<F>) {
        chomp;
        if(/(.*) +([0-9.]+)/) {
            my ($flag, $version)=($1, $2);

            # store the name without the leading dashes
            $flag =~ s/^--//;

            # cut out short option (if present)
            $flag =~ s/ \(-.\)//;

            # store the name without trailing space
            $flag =~ s/ +$//;

            push @options, $flag;

            # options-in-versions says...
            $oiv{$flag} = $version;
        }
    }
    return @options;
}

sub versioncheck {
    my ($f, $v)=@_;
    open(F, "<$cmddir/$f.d");
    while(<F>) {
        chomp;
        if(/^Added: ([0-9.]+)/) {
            if($1 ne $v) {
                print STDERR "$f lists $v in doc but $1 in file\n";
                $error++;
            }
            last;
        }
    }
    close(F);
}

# get all the files
my @cmdopts = cmdfiles($cmddir);

# get all the options mentioned in $o
my @veropts = mentions($opts);

# check if all files are in the doc
for my $c (sort @cmdopts) {
    if($oiv{$c}) {
        # present, but at same version?
        versioncheck($c, $oiv{$c});
    }
    else {
        print STDERR "--$c is in the option directory but not in $opts!\n";
        $error++;
    }
}

# check if the all options in the doc have files
for my $v (sort @veropts) {
    if($file{$v}) {
        # present
    }
    else {
        print STDERR "$v is in the doc but NOT as a file!\n";
        $error++;
    }
}

print STDERR "ok\n" if(!$error);

exit $error;


#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 1998 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
#***************************************************************************

BEGIN {
    push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
    push(@INC, ".");
}

use strict;
use warnings;

use serverhelp qw(
    server_pidfilename
    server_logfilename
    );

use sshhelp qw(
    exe_ext
    );

my $verbose = 0;     # set to 1 for debugging
my $port = 8990;     # just a default
my $ipvnum = 4;      # default IP version of rtsp server
my $idnum = 1;       # default rtsp server instance number
my $proto = 'rtsp';  # protocol the rtsp server speaks
my $pidfile;         # rtsp server pid file
my $portfile;
my $logfile;         # rtsp server log file
my $srcdir;

my $flags  = "";
my $path   = '.';
my $logdir = $path .'/log';

while(@ARGV) {
    if($ARGV[0] eq '--pidfile') {
        if($ARGV[1]) {
            $pidfile = $ARGV[1];
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--portfile') {
        if($ARGV[1]) {
            $portfile = $ARGV[1];
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--logfile') {
        if($ARGV[1]) {
            $logfile = $ARGV[1];
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--srcdir') {
        if($ARGV[1]) {
            $srcdir = $ARGV[1];
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--ipv4') {
        $ipvnum = 4;
    }
    elsif($ARGV[0] eq '--ipv6') {
        $ipvnum = 6;
    }
    elsif($ARGV[0] eq '--port') {
        if($ARGV[1] =~ /^(\d+)$/) {
            $port = $1;
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--id') {
        if($ARGV[1] =~ /^(\d+)$/) {
            $idnum = $1 if($1 > 0);
            shift @ARGV;
        }
    }
    elsif($ARGV[0] eq '--verbose') {
        $verbose = 1;
    }
    else {
        print STDERR "\nWarning: rtspserver.pl unknown parameter: $ARGV[0]\n";
    }
    shift @ARGV;
}

if(!$srcdir) {
    $srcdir = $ENV{'srcdir'} || '.';
}
if(!$pidfile) {
    $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
}
if(!$logfile) {
    $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
}

$flags .= "--pidfile \"$pidfile\" ".
    "--portfile \"$portfile\" ".
    "--logfile \"$logfile\" ";
$flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";

$| = 1;
exec("exec server/rtspd".exe_ext('SRV')." $flags");