globals.pl 33.8 KB
Newer Older
1 2
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
3 4 5 6 7 8 9 10 11 12
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
13
# The Original Code is the Bugzilla Bug Tracking System.
14
#
15
# The Initial Developer of the Original Code is Netscape Communications
16 17 18 19
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
20
# Contributor(s): Terry Weissman <terry@mozilla.org>
21
#                 Dan Mosedale <dmose@mozilla.org>
22
#                 Jake <jake@acutex.net>
23 24 25 26 27

# Contains some global variables and routines used throughout bugzilla.

use diagnostics;
use strict;
28 29 30 31 32 33

# Shut up misguided -w warnings about "used only once".  For some reason,
# "use vars" chokes on me when I try it here.

sub globals_pl_sillyness {
    my $zz;
34
    $zz = @main::SqlStateStack;
35 36
    $zz = @main::chooseone;
    $zz = @main::default_column_list;
37
    $zz = $main::defaultqueryname;
38
    $zz = @main::dontchange;
39
    $zz = %main::keywordsbyname;
40 41
    $zz = @main::legal_bug_status;
    $zz = @main::legal_components;
42
    $zz = @main::legal_keywords;
43 44 45 46 47 48 49 50 51
    $zz = @main::legal_opsys;
    $zz = @main::legal_platform;
    $zz = @main::legal_priority;
    $zz = @main::legal_product;
    $zz = @main::legal_severity;
    $zz = @main::legal_target_milestone;
    $zz = @main::legal_versions;
    $zz = @main::milestoneurl;
    $zz = @main::prodmaxvotes;
52
    $zz = $main::superusergroupset;
53 54
}

55 56 57 58 59
#
# Here are the --LOCAL-- variables defined in 'localconfig' that we'll use
# here
# 

tara%tequilarista.org's avatar
tara%tequilarista.org committed
60 61 62 63
$::db_host = "localhost";
$::db_name = "bugs";
$::db_user = "bugs";
$::db_pass = "";
64 65 66

do 'localconfig';

67
use DBI;
68 69

use Date::Format;               # For time2str().
70
use Date::Parse;               # For str2time().
71
# use Carp;                       # for confess
72
use RelationSet;
73

74
# Contains the version string for the current running Bugzilla.
75
$::param{'version'} = '2.13';
76

77 78
$::dontchange = "--do_not_change--";
$::chooseone = "--Choose_one:--";
79
$::defaultqueryname = "(Default query)";
80
$::unconfirmedstate = "UNCONFIRMED";
81
$::dbwritesallowed = 1;
82

83 84 85 86
# Adding a global variable for the value of the superuser groupset.
# Joe Robins, 7/5/00
$::superusergroupset = "9223372036854775807";

87
sub ConnectToDatabase {
88
    my ($useshadow) = (@_);
89
    if (!defined $::db) {
tara%tequilarista.org's avatar
tara%tequilarista.org committed
90
        my $name = $::db_name;
91
        if ($useshadow && Param("shadowdb") && Param("queryagainstshadowdb")) {
92 93 94
            $name = Param("shadowdb");
            $::dbwritesallowed = 0;
        }
tara%tequilarista.org's avatar
tara%tequilarista.org committed
95
	$::db = DBI->connect("DBI:mysql:host=$::db_host;database=$name", $::db_user, $::db_pass)
96 97 98
	    || die "Bugzilla is currently broken. Please try again later. " . 
      "If the problem persists, please contact " . Param("maintainer") .
      ". The error you should quote is: " . $DBI::errstr;
99 100 101
    }
}

102
sub ReconnectToShadowDatabase {
103
    if (Param("shadowdb") && Param("queryagainstshadowdb")) {
104 105 106 107 108
        SendSQL("USE " . Param("shadowdb"));
        $::dbwritesallowed = 0;
    }
}

109 110 111
my $shadowchanges = 0;
sub SyncAnyPendingShadowChanges {
    if ($shadowchanges) {
112 113 114 115 116 117 118 119
        my $pid;
        FORK: {
            if ($pid = fork) { # create a fork
                # parent code runs here
                $shadowchanges = 0;
                return;
            } elsif (defined $pid) {
                # child process code runs here
120 121 122 123 124
                exec("./syncshadowdb","--") or die "Unable to exec syncshadowdb: $!";
                # the idea was that passing the second parameter tricks it into
                # using execvp instead of running a shell. Not really necessary since
                # there are no shell meta-characters, but it passes our tinderbox
                # test that way. :) http://bugzilla.mozilla.org/show_bug.cgi?id=21253
125 126 127 128 129 130 131 132 133
            } elsif ($! =~ /No more process/) {
                # recoverable fork error, try again in 5 seconds
                sleep 5;
                redo FORK;
            } else {
                # something weird went wrong
                die "Can't create background process to run syncshadowdb: $!";
            }
        }
134 135
    }
}
136

137

138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
# This is used to manipulate global state used by SendSQL(),
# MoreSQLData() and FetchSQLData().  It provides a way to do another
# SQL query without losing any as-yet-unfetched data from an existing
# query.  Just push the current global state, do your new query and fetch
# any data you need from it, then pop the current global state.
# 
@::SQLStateStack = ();

sub PushGlobalSQLState() {
    push @::SQLStateStack, $::currentquery;
    push @::SQLStateStack, [ @::fetchahead ]; 
}

sub PopGlobalSQLState() {
    die ("PopGlobalSQLState: stack underflow") if ( $#::SQLStateStack < 1 );
    @::fetchahead = @{pop @::SQLStateStack};
    $::currentquery = pop @::SQLStateStack;
}

sub SavedSQLStates() {
    return ($#::SqlStateStack + 1) / 2;
}


162 163 164 165 166 167 168
my $dosqllog = (-e "data/sqllog") && (-w "data/sqllog");

sub SqlLog {
    if ($dosqllog) {
        my ($str) = (@_);
        open(SQLLOGFID, ">>data/sqllog") || die "Can't write to data/sqllog";
        if (flock(SQLLOGFID,2)) { # 2 is magic 'exclusive lock' const.
169 170 171 172 173 174 175 176

            # if we're a subquery (ie there's pushed global state around)
            # indent to indicate the level of subquery-hood
            #
            for (my $i = SavedSQLStates() ; $i > 0 ; $i--) {
                print SQLLOGFID "\t";
            }

177 178 179 180 181 182
            print SQLLOGFID time2str("%D %H:%M:%S $$", time()) . ": $str\n";
        }
        flock(SQLLOGFID,8);     # '8' is magic 'unlock' const.
        close SQLLOGFID;
    }
}
183

184
sub SendSQL {
185 186 187 188 189
    my ($str, $dontshadow) = (@_);
    my $iswrite =  ($str =~ /^(INSERT|REPLACE|UPDATE|DELETE)/i);
    if ($iswrite && !$::dbwritesallowed) {
        die "Evil code attempted to write stuff to the shadow database.";
    }
190
    if ($str =~ /^LOCK TABLES/i && $str !~ /shadowlog/ && $::dbwritesallowed) {
191
        $str =~ s/^LOCK TABLES/LOCK TABLES shadowlog WRITE, /i;
192
    }
193
    SqlLog($str);
194 195
    $::currentquery = $::db->prepare($str);
    $::currentquery->execute
196
	|| die "$str: " . $::db->errstr;
197
    SqlLog("Done");
198 199 200 201 202 203 204 205 206 207 208
    if (!$dontshadow && $iswrite && Param("shadowdb")) {
        my $q = SqlQuote($str);
        my $insertid;
        if ($str =~ /^(INSERT|REPLACE)/i) {
            SendSQL("SELECT LAST_INSERT_ID()");
            $insertid = FetchOneColumn();
        }
        SendSQL("INSERT INTO shadowlog (command) VALUES ($q)", 1);
        if ($insertid) {
            SendSQL("SET LAST_INSERT_ID = $insertid");
        }
209
        $shadowchanges++;
210
    }
211 212 213 214 215 216
}

sub MoreSQLData {
    if (defined @::fetchahead) {
	return 1;
    }
217
    if (@::fetchahead = $::currentquery->fetchrow_array) {
218 219 220 221 222 223 224 225 226 227 228
	return 1;
    }
    return 0;
}

sub FetchSQLData {
    if (defined @::fetchahead) {
	my @result = @::fetchahead;
	undef @::fetchahead;
	return @result;
    }
229
    return $::currentquery->fetchrow_array;
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244
}


sub FetchOneColumn {
    my @row = FetchSQLData();
    return $row[0];
}

    

@::default_column_list = ("severity", "priority", "platform", "owner",
                          "status", "resolution", "summary");

sub AppendComment {
    my ($bugid,$who,$comment) = (@_);
245 246
    $comment =~ s/\r\n/\n/g;     # Get rid of windows-style line endings.
    $comment =~ s/\r/\n/g;       # Get rid of mac-style line endings.
247 248 249
    if ($comment =~ /^\s*$/) {  # Nothin' but whitespace.
        return;
    }
250 251 252 253 254

    my $whoid = DBNameToIdAndCheck($who);

    SendSQL("INSERT INTO longdescs (bug_id, who, bug_when, thetext) " .
            "VALUES($bugid, $whoid, now(), " . SqlQuote($comment) . ")");
255 256

    SendSQL("UPDATE bugs SET delta_ts = now() WHERE bug_id = $bugid");
257 258
}

259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274
sub GetFieldID {
    my ($f) = (@_);
    SendSQL("SELECT fieldid FROM fielddefs WHERE name = " . SqlQuote($f));
    my $fieldid = FetchOneColumn();
    if (!$fieldid) {
        my $q = SqlQuote($f);
        SendSQL("REPLACE INTO fielddefs (name, description) VALUES ($q, $q)");
        SendSQL("SELECT LAST_INSERT_ID()");
        $fieldid = FetchOneColumn();
    }
    return $fieldid;
}
        



275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
sub lsearch {
    my ($list,$item) = (@_);
    my $count = 0;
    foreach my $i (@$list) {
        if ($i eq $item) {
            return $count;
        }
        $count++;
    }
    return -1;
}

sub Product_element {
    my ($prod,$onchange) = (@_);
    return make_popup("product", keys %::versions, $prod, 1, $onchange);
}

sub Component_element {
    my ($comp,$prod,$onchange) = (@_);
    my $componentlist;
    if (! defined $::components{$prod}) {
        $componentlist = [];
    } else {
        $componentlist = $::components{$prod};
    }
    my $defcomponent;
    if ($comp ne "" && lsearch($componentlist, $comp) >= 0) {
        $defcomponent = $comp;
    } else {
        $defcomponent = $componentlist->[0];
    }
    return make_popup("component", $componentlist, $defcomponent, 1, "");
}

sub Version_element {
    my ($vers, $prod, $onchange) = (@_);
    my $versionlist;
    if (!defined $::versions{$prod}) {
        $versionlist = [];
    } else {
        $versionlist = $::versions{$prod};
    }
    my $defversion = $versionlist->[0];
    if (lsearch($versionlist,$vers) >= 0) {
        $defversion = $vers;
    }
    return make_popup("version", $versionlist, $defversion, 1, $onchange);
}
        
324 325 326 327 328 329 330 331
sub Milestone_element {
    my ($tm, $prod, $onchange) = (@_);
    my $tmlist;
    if (!defined $::target_milestone{$prod}) {
        $tmlist = [];
    } else {
        $tmlist = $::target_milestone{$prod};
    }
332

333 334 335 336 337 338 339 340
    my $deftm = $tmlist->[0];

    if (lsearch($tmlist, $tm) >= 0) {
        $deftm = $tm;
    }

    return make_popup("target_milestone", $tmlist, $deftm, 1, $onchange);
}
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419

# Generate a string which, when later interpreted by the Perl compiler, will
# be the same as the given string.

sub PerlQuote {
    my ($str) = (@_);
    return SqlQuote($str);
    
# The below was my first attempt, but I think just using SqlQuote makes more 
# sense...
#     $result = "'";
#     $length = length($str);
#     for (my $i=0 ; $i<$length ; $i++) {
#         my $c = substr($str, $i, 1);
#         if ($c eq "'" || $c eq '\\') {
#             $result .= '\\';
#         }
#         $result .= $c;
#     }
#     $result .= "'";
#     return $result;
}


# Given the name of a global variable, generate Perl code that, if later
# executed, would restore the variable to its current value.

sub GenerateCode {
    my ($name) = (@_);
    my $result = $name . " = ";
    if ($name =~ /^\$/) {
        my $value = eval($name);
        if (ref($value) eq "ARRAY") {
            $result .= "[" . GenerateArrayCode($value) . "]";
        } else {
            $result .= PerlQuote(eval($name));
        }
    } elsif ($name =~ /^@/) {
        my @value = eval($name);
        $result .= "(" . GenerateArrayCode(\@value) . ")";
    } elsif ($name =~ '%') {
        $result = "";
        foreach my $k (sort { uc($a) cmp uc($b)} eval("keys $name")) {
            $result .= GenerateCode("\$" . substr($name, 1) .
                                    "{'" . $k . "'}");
        }
        return $result;
    } else {
        die "Can't do $name -- unacceptable variable type.";
    }
    $result .= ";\n";
    return $result;
}

sub GenerateArrayCode {
    my ($ref) = (@_);
    my @list;
    foreach my $i (@$ref) {
        push @list, PerlQuote($i);
    }
    return join(',', @list);
}



sub GenerateVersionTable {
    ConnectToDatabase();
    SendSQL("select value, program from versions order by value");
    my @line;
    my %varray;
    my %carray;
    while (@line = FetchSQLData()) {
        my ($v,$p1) = (@line);
        if (!defined $::versions{$p1}) {
            $::versions{$p1} = [];
        }
        push @{$::versions{$p1}}, $v;
        $varray{$v} = 1;
    }
420
    SendSQL("select value, program from components order by value");
421 422 423 424 425 426 427 428 429 430
    while (@line = FetchSQLData()) {
        my ($c,$p) = (@line);
        if (!defined $::components{$p}) {
            $::components{$p} = [];
        }
        my $ref = $::components{$p};
        push @$ref, $c;
        $carray{$c} = 1;
    }

431 432 433 434 435
    my $dotargetmilestone = 1;  # This used to check the param, but there's
                                # enough code that wants to pretend we're using
                                # target milestones, even if they don't get
                                # shown to the user.  So we cache all the data
                                # about them anyway.
436 437

    my $mpart = $dotargetmilestone ? ", milestoneurl" : "";
438
    SendSQL("select product, description, votesperuser, disallownew$mpart from products");
439
    $::anyvotesallowed = 0;
440
    while (@line = FetchSQLData()) {
441
        my ($p, $d, $votesperuser, $dis, $u) = (@line);
442
        $::proddesc{$p} = $d;
443 444 445 446 447 448
        if ($dis) {
            # Special hack.  Stomp on the description and make it "0" if we're
            # not supposed to allow new bugs against this product.  This is
            # checked for in enter_bug.cgi.
            $::proddesc{$p} = "0";
        }
449 450 451
        if ($dotargetmilestone) {
            $::milestoneurl{$p} = $u;
        }
452
        $::prodmaxvotes{$p} = $votesperuser;
453 454 455
        if ($votesperuser > 0) {
            $::anyvotesallowed = 1;
        }
456 457 458
    }
            

459 460 461
    my $cols = LearnAboutColumns("bugs");
    
    @::log_columns = @{$cols->{"-list-"}};
462
    foreach my $i ("bug_id", "creation_ts", "delta_ts", "lastdiffed") {
463 464 465 466 467
        my $w = lsearch(\@::log_columns, $i);
        if ($w >= 0) {
            splice(@::log_columns, $w, 1);
        }
    }
468
    @::log_columns = (sort(@::log_columns));
469 470 471 472

    @::legal_priority = SplitEnumType($cols->{"priority,type"});
    @::legal_severity = SplitEnumType($cols->{"bug_severity,type"});
    @::legal_platform = SplitEnumType($cols->{"rep_platform,type"});
473
    @::legal_opsys = SplitEnumType($cols->{"op_sys,type"});
474 475
    @::legal_bug_status = SplitEnumType($cols->{"bug_status,type"});
    @::legal_resolution = SplitEnumType($cols->{"resolution,type"});
476 477 478 479 480 481 482 483

    # 'settable_resolution' is the list of resolutions that may be set 
    # directly by hand in the bug form. Start with the list of legal 
    # resolutions and remove 'MOVED' and 'DUPLICATE' because setting 
    # bugs to those resolutions requires a special process.
    #
    @::settable_resolution = @::legal_resolution;
    my $w = lsearch(\@::settable_resolution, "DUPLICATE");
484
    if ($w >= 0) {
485 486 487 488 489
        splice(@::settable_resolution, $w, 1);
    }
    my $z = lsearch(\@::settable_resolution, "MOVED");
    if ($z >= 0) {
        splice(@::settable_resolution, $z, 1);
490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511
    }

    my @list = sort { uc($a) cmp uc($b)} keys(%::versions);
    @::legal_product = @list;
    mkdir("data", 0777);
    chmod 0777, "data";
    my $tmpname = "data/versioncache.$$";
    open(FID, ">$tmpname") || die "Can't create $tmpname";

    print FID GenerateCode('@::log_columns');
    print FID GenerateCode('%::versions');

    foreach my $i (@list) {
        if (!defined $::components{$i}) {
            $::components{$i} = "";
        }
    }
    @::legal_versions = sort {uc($a) cmp uc($b)} keys(%varray);
    print FID GenerateCode('@::legal_versions');
    print FID GenerateCode('%::components');
    @::legal_components = sort {uc($a) cmp uc($b)} keys(%carray);
    print FID GenerateCode('@::legal_components');
512
    foreach my $i('product', 'priority', 'severity', 'platform', 'opsys',
513
                  'bug_status', 'resolution') {
514 515
        print FID GenerateCode('@::legal_' . $i);
    }
516
    print FID GenerateCode('@::settable_resolution');
517
    print FID GenerateCode('%::proddesc');
518
    print FID GenerateCode('%::prodmaxvotes');
519
    print FID GenerateCode('$::anyvotesallowed');
520

521
    if ($dotargetmilestone) {
522 523 524 525 526 527 528 529 530 531 532 533 534 535 536
        # reading target milestones in from the database - matthew@zeroknowledge.com
        SendSQL("SELECT value, product FROM milestones ORDER BY sortkey, value");
        my @line;
        my %tmarray;
        @::legal_target_milestone = ();
        while(@line = FetchSQLData()) {
            my ($tm, $pr) = (@line);
            if (!defined $::target_milestone{$pr}) {
                $::target_milestone{$pr} = [];
            }
            push @{$::target_milestone{$pr}}, $tm;
            if (!exists $tmarray{$tm}) {
                $tmarray{$tm} = 1;
                push(@::legal_target_milestone, $tm);
            }
537
        }
538 539

        print FID GenerateCode('%::target_milestone');
540
        print FID GenerateCode('@::legal_target_milestone');
541
        print FID GenerateCode('%::milestoneurl');
542
    }
543 544 545 546

    SendSQL("SELECT id, name FROM keyworddefs ORDER BY name");
    while (MoreSQLData()) {
        my ($id, $name) = FetchSQLData();
547
        push(@::legal_keywords, $name);
548
        $name = lc($name);
549 550 551 552 553
        $::keywordsbyname{$name} = $id;
    }
    print FID GenerateCode('@::legal_keywords');
    print FID GenerateCode('%::keywordsbyname');

554 555 556 557 558 559 560
    print FID "1;\n";
    close FID;
    rename $tmpname, "data/versioncache" || die "Can't rename $tmpname to versioncache";
    chmod 0666, "data/versioncache";
}


561 562 563 564 565 566 567 568
sub GetKeywordIdFromName {
    my ($name) = (@_);
    $name = lc($name);
    return $::keywordsbyname{$name};
}



569 570 571 572 573 574 575 576 577 578 579 580 581 582 583

# Returns the modification time of a file.

sub ModTime {
    my ($filename) = (@_);
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks)
        = stat($filename);
    return $mtime;
}



# This proc must be called before using legal_product or the versions array.

584
$::VersionTableLoaded = 0;
585
sub GetVersionTable {
586
    return if $::VersionTableLoaded;
587 588 589 590 591 592 593 594 595 596 597 598 599
    my $mtime = ModTime("data/versioncache");
    if (!defined $mtime || $mtime eq "") {
        $mtime = 0;
    }
    if (time() - $mtime > 3600) {
        GenerateVersionTable();
    }
    require 'data/versioncache';
    if (!defined %::versions) {
        GenerateVersionTable();
        do 'data/versioncache';

        if (!defined %::versions) {
600
            die "Can't generate file data/versioncache";
601 602
        }
    }
603
    $::VersionTableLoaded = 1;
604 605 606 607
}


sub InsertNewUser {
608
    my ($username, $realname) = (@_);
609 610 611 612
    my $password = "";
    for (my $i=0 ; $i<8 ; $i++) {
        $password .= substr("abcdefghijklmnopqrstuvwxyz", int(rand(26)), 1);
    }
613

614
    PushGlobalSQLState();
615 616 617 618
    SendSQL("select bit, userregexp from groups where userregexp != ''");
    my $groupset = "0";
    while (MoreSQLData()) {
        my @row = FetchSQLData();
619 620 621 622
	# Modified -Joe Robins, 2/17/00
	# Making this case insensitive, since usernames are email addresses,
	# and could be any case.
        if ($username =~ m/$row[1]/i) {
623 624 625 626 627 628 629
            $groupset .= "+ $row[0]"; # Silly hack to let MySQL do the math,
                                      # not Perl, since we're dealing with 64
                                      # bit ints here, and I don't *think* Perl
                                      # does that.
        }
    }
            
630 631
    $username = SqlQuote($username);
    $realname = SqlQuote($realname);
632
    SendSQL("insert into profiles (login_name, realname, password, cryptpassword, groupset) values ($username, $realname, '$password', encrypt('$password'), $groupset)");
633
    PopGlobalSQLState();
634 635 636
    return $password;
}

637
sub DBID_to_real_or_loginname {
638
    my ($id) = (@_);
639
    PushGlobalSQLState();
640 641
    SendSQL("SELECT login_name,realname FROM profiles WHERE userid = $id");
    my ($l, $r) = FetchSQLData();
642
    PopGlobalSQLState();
643
    if (!defined $r || $r eq "") {
644
        return $l;
645
    } else {
646
        return "$l ($r)";
647 648
    }
}
649 650 651 652

sub DBID_to_name {
    my ($id) = (@_);
    if (!defined $::cachedNameArray{$id}) {
653
        PushGlobalSQLState();
654 655
        SendSQL("select login_name from profiles where userid = $id");
        my $r = FetchOneColumn();
656
        PopGlobalSQLState();
657
        if (!defined $r || $r eq "") {
658 659 660 661 662 663 664 665 666
            $r = "__UNKNOWN__";
        }
        $::cachedNameArray{$id} = $r;
    }
    return $::cachedNameArray{$id};
}

sub DBname_to_id {
    my ($name) = (@_);
667
    PushGlobalSQLState();
668 669
    SendSQL("select userid from profiles where login_name = @{[SqlQuote($name)]}");
    my $r = FetchOneColumn();
670
    PopGlobalSQLState();
671
    if (!defined $r || $r eq "") {
672 673 674 675 676 677 678 679 680 681 682 683 684
        return 0;
    }
    return $r;
}


sub DBNameToIdAndCheck {
    my ($name, $forceok) = (@_);
    my $result = DBname_to_id($name);
    if ($result > 0) {
        return $result;
    }
    if ($forceok) {
685
        InsertNewUser($name, "");
686 687 688 689 690 691 692
        $result = DBname_to_id($name);
        if ($result > 0) {
            return $result;
        }
        print "Yikes; couldn't create user $name.  Please report problem to " .
            Param("maintainer") ."\n";
    } else {
693
        print "\n";  # http://bugzilla.mozilla.org/show_bug.cgi?id=80045
694 695 696 697
        print "The name <TT>$name</TT> is not a valid username.  Either you\n";
        print "misspelled it, or the person has not registered for a\n";
        print "Bugzilla account.\n";
        print "<P>Please hit the <B>Back</B> button and try again.\n";
698 699 700 701
    }
    exit(0);
}

702 703 704 705 706 707 708 709
# This routine quoteUrls contains inspirations from the HTML::FromText CPAN
# module by Gareth Rees <garethr@cre.canon.co.uk>.  It has been heavily hacked,
# all that is really recognizable from the original is bits of the regular
# expressions.

sub quoteUrls {
    my ($knownattachments, $text) = (@_);
    return $text unless $text;
710
    
711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748
    my $base = Param('urlbase');

    my $protocol = join '|',
    qw(afs cid ftp gopher http https mid news nntp prospero telnet wais);

    my %options = ( metachars => 1, @_ );

    my $count = 0;

    # Now, quote any "#" characters so they won't confuse stuff later
    $text =~ s/#/%#/g;

    # Next, find anything that looks like a URL or an email address and
    # pull them out the the text, replacing them with a "##<digits>##
    # marker, and writing them into an array.  All this confusion is
    # necessary so that we don't match on something we've already replaced,
    # which can happen if you do multiple s///g operations.

    my @things;
    while ($text =~ s%((mailto:)?([\w\.\-\+\=]+\@[\w\-]+(?:\.[\w\-]+)+)\b|
                    (\b((?:$protocol):[^ \t\n<>"]+[\w/])))%"##$count##"%exo) {
        my $item = $&;

        $item = value_quote($item);

        if ($item !~ m/^$protocol:/o && $item !~ /^mailto:/) {
            # We must have grabbed this one because it looks like an email
            # address.
            $item = qq{<A HREF="mailto:$item">$item</A>};
        } else {
            $item = qq{<A HREF="$item">$item</A>};
        }

        $things[$count++] = $item;
    }
    while ($text =~ s/\bbug(\s|%\#)*(\d+)/"##$count##"/ei) {
        my $item = $&;
        my $num = $2;
749
        $item = GetBugLink($num, $item);
750 751
        $things[$count++] = $item;
    }
752 753 754 755 756 757 758 759
    while ($text =~ s/\battachment(\s|%\#)*(\d+)/"##$count##"/ei) {
        my $item = $&;
        my $num = $2;
        $item = value_quote($item); # Not really necessary, since we know
                                    # there's no special chars in it.
        $item = qq{<A HREF="showattachment.cgi?attach_id=$num">$item</A>};
        $things[$count++] = $item;
    }
760 761 762
    while ($text =~ s/\*\*\* This bug has been marked as a duplicate of (\d+) \*\*\*/"##$count##"/ei) {
        my $item = $&;
        my $num = $1;
763 764 765
        my $bug_link;
        $bug_link = GetBugLink($num, $num);
        $item =~ s@\d+@$bug_link@;
766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787
        $things[$count++] = $item;
    }
    while ($text =~ s/Created an attachment \(id=(\d+)\)/"##$count##"/e) {
        my $item = $&;
        my $num = $1;
        if ($knownattachments->{$num}) {
            $item = qq{<A HREF="showattachment.cgi?attach_id=$num">$item</A>};
        }
        $things[$count++] = $item;
    }

    $text = value_quote($text);
    $text =~ s/\&#010;/\n/g;

    # Stuff everything back from the array.
    for (my $i=0 ; $i<$count ; $i++) {
        $text =~ s/##$i##/$things[$i]/e;
    }

    # And undo the quoting of "#" characters.
    $text =~ s/%#/#/g;

788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810
    return $text;
}

# This is a new subroutine written 12/20/00 for the purpose of processing a
# link to a bug.  It can be called using "GetBugLink (<BugNumber>, <LinkText>);"
# Where <BugNumber> is the number of the bug and <LinkText> is what apprears
# between '<a>' and '</a>'.

sub GetBugLink {
    my ($bug_num, $link_text) = (@_);
    my ($link_return) = "";

    # TODO - Add caching capabilites... possibly use a global variable in the form
    # of $buglink{$bug_num} that contains the text returned by this sub.  If that
    # variable is defined, simply return it's value rather than running the SQL
    # query.  This would cut down on the number of SQL calls when the same bug is
    # referenced multiple times.
    
    # Make sure any unfetched data from a currently running query
    # is saved off rather than overwritten
    PushGlobalSQLState();
    
    # Get this bug's info from the SQL Database
811
    SendSQL("select bugs.bug_status, resolution, short_desc, groupset
812
             from bugs where bugs.bug_id = $bug_num");
813
    my ($bug_stat, $bug_res, $bug_desc, $bug_grp) = (FetchSQLData());
814 815 816 817 818 819 820 821
    
    # Format the retrieved information into a link
    if ($bug_stat eq "UNCONFIRMED") { $link_return .= "<i>" }
    if ($bug_res ne "") { $link_return .= "<strike>" }
    $bug_desc = value_quote($bug_desc);
    $link_text = value_quote($link_text);
    $link_return .= qq{<a href="show_bug.cgi?id=$bug_num" title="$bug_stat};
    if ($bug_res ne "") {$link_return .= " $bug_res"}
822 823
    if ($bug_grp == 0) { $link_return .= " - $bug_desc" }
    $link_return .= qq{">$link_text</a>};
824 825 826 827
    if ($bug_res ne "") { $link_return .= "</strike>" }
    if ($bug_stat eq "UNCONFIRMED") { $link_return .= "</i>"}
    
    # Put back any query in progress
828 829
    PopGlobalSQLState();

830 831
    return $link_return; 

832 833 834
}

sub GetLongDescriptionAsText {
835
    my ($id, $start, $end) = (@_);
836 837
    my $result = "";
    my $count = 0;
838 839 840 841 842 843 844 845
    my ($query) = ("SELECT profiles.login_name, longdescs.bug_when, " .
                   "       longdescs.thetext " .
                   "FROM longdescs, profiles " .
                   "WHERE profiles.userid = longdescs.who " .
                   "      AND longdescs.bug_id = $id ");

    if ($start && $start =~ /[1-9]/) {
        # If the start is all zeros, then don't do this (because we want to
846
        # not emit a leading "Additional Comments" line in that case.)
847 848 849 850 851 852 853 854 855
        $query .= "AND longdescs.bug_when > '$start'";
        $count = 1;
    }
    if ($end) {
        $query .= "AND longdescs.bug_when <= '$end'";
    }

    $query .= "ORDER BY longdescs.bug_when";
    SendSQL($query);
856 857 858
    while (MoreSQLData()) {
        my ($who, $when, $text) = (FetchSQLData());
        if ($count) {
859
            $result .= "\n\n------- Additional Comments From $who".Param('emailsuffix')."  ".
860 861 862 863 864 865 866
                time2str("%Y-%m-%d %H:%M", str2time($when)) . " -------\n";
        }
        $result .= $text;
        $count++;
    }

    return $result;
867 868 869
}


870 871 872 873 874 875 876 877 878 879
sub GetLongDescriptionAsHTML {
    my ($id, $start, $end) = (@_);
    my $result = "";
    my $count = 0;
    my %knownattachments;
    SendSQL("SELECT attach_id FROM attachments WHERE bug_id = $id");
    while (MoreSQLData()) {
        $knownattachments{FetchOneColumn()} = 1;
    }

880
    my ($query) = ("SELECT profiles.realname, profiles.login_name, longdescs.bug_when, " .
881 882 883 884 885 886 887
                   "       longdescs.thetext " .
                   "FROM longdescs, profiles " .
                   "WHERE profiles.userid = longdescs.who " .
                   "      AND longdescs.bug_id = $id ");

    if ($start && $start =~ /[1-9]/) {
        # If the start is all zeros, then don't do this (because we want to
888
        # not emit a leading "Additional Comments" line in that case.)
889 890 891 892 893 894 895 896 897 898
        $query .= "AND longdescs.bug_when > '$start'";
        $count = 1;
    }
    if ($end) {
        $query .= "AND longdescs.bug_when <= '$end'";
    }

    $query .= "ORDER BY longdescs.bug_when";
    SendSQL($query);
    while (MoreSQLData()) {
899
        my ($who, $email, $when, $text) = (FetchSQLData());
900
        $email .= Param('emailsuffix');
901
        if ($count) {
902 903 904 905 906 907 908 909 910 911
            $result .= "<BR><BR><I>------- Additional Comments From ";
              if ($who) {
                  $result .= qq{<A HREF="mailto:$email">$who</A> } .
                      time2str("%Y-%m-%d %H:%M", str2time($when)) .
                          " -------</I><BR>\n";
              } else {
                  $result .= qq{<A HREF="mailto:$email">$email</A> } .
                      time2str("%Y-%m-%d %H:%M", str2time($when)) .
                          " -------</I><BR>\n";
              }
912 913 914 915 916 917 918 919
        }
        $result .= "<PRE>" . quoteUrls(\%knownattachments, $text) . "</PRE>\n";
        $count++;
    }

    return $result;
}

920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962
# Fills in a hashtable with info about the columns for the given table in the
# database.  The hashtable has the following entries:
#   -list-  the list of column names
#   <name>,type  the type for the given name

sub LearnAboutColumns {
    my ($table) = (@_);
    my %a;
    SendSQL("show columns from $table");
    my @list = ();
    my @row;
    while (@row = FetchSQLData()) {
        my ($name,$type) = (@row);
        $a{"$name,type"} = $type;
        push @list, $name;
    }
    $a{"-list-"} = \@list;
    return \%a;
}



# If the above returned a enum type, take that type and parse it into the
# list of values.  Assumes that enums don't ever contain an apostrophe!

sub SplitEnumType {
    my ($str) = (@_);
    my @result = ();
    if ($str =~ /^enum\((.*)\)$/) {
        my $guts = $1 . ",";
        while ($guts =~ /^\'([^\']*)\',(.*)$/) {
            push @result, $1;
            $guts = $2;
	}
    }
    return @result;
}


# This routine is largely copied from Mysql.pm.

sub SqlQuote {
    my ($str) = (@_);
963 964 965
#     if (!defined $str) {
#         confess("Undefined passed to SqlQuote");
#     }
966 967 968 969 970 971 972
    $str =~ s/([\\\'])/\\$1/g;
    $str =~ s/\0/\\0/g;
    return "'$str'";
}



973 974 975 976 977 978 979 980 981 982 983 984 985 986
sub UserInGroup {
    my ($groupname) = (@_);
    if ($::usergroupset eq "0") {
        return 0;
    }
    ConnectToDatabase();
    SendSQL("select (bit & $::usergroupset) != 0 from groups where name = " . SqlQuote($groupname));
    my $bit = FetchOneColumn();
    if ($bit) {
        return 1;
    }
    return 0;
}

987 988 989 990 991 992 993
sub GroupExists {
    my ($groupname) = (@_);
    ConnectToDatabase();
    SendSQL("select count(*) from groups where name=" . SqlQuote($groupname));
    my $count = FetchOneColumn();
    return $count;
}
994

995 996 997 998 999 1000 1001 1002 1003 1004 1005
# Determines whether or not a group is active by checking 
# the "isactive" column for the group in the "groups" table.
# Note: This function selects groups by bit rather than by name.
sub GroupIsActive {
    my ($groupbit) = (@_);
    ConnectToDatabase();
    SendSQL("select isactive from groups where bit=$groupbit");
    my $isactive = FetchOneColumn();
    return $isactive;
}

1006 1007 1008 1009 1010 1011
# Determines if the given bug_status string represents an "Opened" bug.  This
# routine ought to be paramaterizable somehow, as people tend to introduce
# new states into Bugzilla.

sub IsOpenedState {
    my ($state) = (@_);
1012
    if ($state =~ /^(NEW|REOPENED|ASSIGNED)$/ || $state eq $::unconfirmedstate) {
1013 1014 1015 1016 1017 1018
        return 1;
    }
    return 0;
}


1019
sub RemoveVotes {
1020
    my ($id, $who, $reason) = (@_);
1021
    ConnectToDatabase();
1022 1023 1024 1025 1026 1027 1028 1029 1030
    my $whopart = "";
    if ($who) {
        $whopart = " AND votes.who = $who";
    }
    SendSQL("SELECT profiles.login_name, votes.count " .
            "FROM votes, profiles " .
            "WHERE votes.bug_id = $id " .
            "AND profiles.userid = votes.who" .
            $whopart);
1031 1032
    my @list;
    while (MoreSQLData()) {
1033
        my ($name, $count) = (FetchSQLData());
1034
        push(@list, [$name, $count]);
1035 1036
    }
    if (0 < @list) {
1037 1038
        foreach my $ref (@list) {
            my ($name, $count) = (@$ref);
1039 1040 1041 1042 1043
            my $sendmailparm = '-ODeliveryMode=deferred';
            if (Param('sendmailnow')) {
               $sendmailparm = '';
            }
            if (open(SENDMAIL, "|/usr/lib/sendmail $sendmailparm -t")) {
1044 1045 1046 1047 1048
                my %substs;
                $substs{"to"} = $name;
                $substs{"bugid"} = $id;
                $substs{"reason"} = $reason;
                $substs{"count"} = $count;
1049 1050 1051
                my $msg = PerformSubsts(Param("voteremovedmail"),
                                        \%substs);
                print SENDMAIL $msg;
1052 1053
                close SENDMAIL;
            }
1054
        }
1055 1056 1057 1058 1059 1060
        SendSQL("DELETE FROM votes WHERE bug_id = $id" . $whopart);
        SendSQL("SELECT SUM(count) FROM votes WHERE bug_id = $id");
        my $v = FetchOneColumn();
        $v ||= 0;
        SendSQL("UPDATE bugs SET votes = $v, delta_ts = delta_ts " .
                "WHERE bug_id = $id");
1061 1062 1063 1064
    }
}


1065
sub Param ($) {
1066 1067 1068 1069
    my ($value) = (@_);
    if (defined $::param{$value}) {
        return $::param{$value};
    }
1070 1071 1072 1073 1074 1075 1076 1077

    # See if it is a dynamically-determined param (can't be changed by user).
    if ($value eq "commandmenu") {
        return GetCommandMenu();
    }
    if ($value eq "settingsmenu") {
        return GetSettingsMenu();
    }
1078 1079
    # Um, maybe we haven't sourced in the params at all yet.
    if (stat("data/params")) {
1080 1081 1082 1083 1084
        # Write down and restore the version # here.  That way, we get around
        # anyone who maliciously tries to tweak the version number by editing
        # the params file.  Not to mention that in 2.0, there was a bug that
        # wrote the version number out to the params file...
        my $v = $::param{'version'};
1085
        require "data/params";
1086
        $::param{'version'} = $v;
1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113
    }
    if (defined $::param{$value}) {
        return $::param{$value};
    }
    # Well, that didn't help.  Maybe it's a new param, and the user
    # hasn't defined anything for it.  Try and load a default value
    # for it.
    require "defparams.pl";
    WriteParams();
    if (defined $::param{$value}) {
        return $::param{$value};
    }
    # We're pimped.
    die "Can't find param named $value";
}

sub PerformSubsts {
    my ($str, $substs) = (@_);
    $str =~ s/%([a-z]*)%/(defined $substs->{$1} ? $substs->{$1} : Param($1))/eg;
    return $str;
}


# Trim whitespace from front and back.

sub trim {
    ($_) = (@_);
1114 1115
    s/^\s+//g;
    s/\s+$//g;
1116 1117 1118 1119
    return $_;
}

1;