~ubuntu-branches/ubuntu/precise/apparmor/precise-security : revision 28

1

# ----------------------------------------------------------------------

2

3

4

#

5

# This program is free software; you can redistribute it and/or

6

# modify it under the terms of version 2 of the GNU General Public

7

# License as published by the Free Software Foundation.

8

#

9

# This program is distributed in the hope that it will be useful,

10

# but WITHOUT ANY WARRANTY; without even the implied warranty of

11

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12

# GNU General Public License for more details.

13

#

14

# You should have received a copy of the GNU General Public License

15

# along with this program; if not, contact Novell, Inc.

16

#

17

# To contact Novell about this file by physical or electronic mail,

18

# you may find current contact information at www.novell.com.

19

# ----------------------------------------------------------------------

20

21

package Immunix::AppArmor;

22

23

use strict;

24

use warnings;

25

26

use Carp;

27

use Cwd qw(cwd realpath);

28

use File::Basename;

29

use File::Temp qw/ tempfile tempdir /;

30

use Data::Dumper;

31

32

use Locale::gettext;

33

use POSIX;

34

use Storable qw(dclone);

35

36

use Term::ReadKey;

37

38

use Immunix::Severity;

39

use Immunix::Repository;

40

use Immunix::Config;

41

use LibAppArmor;

42

43

require Exporter;

44

our @ISA = qw(Exporter);

45

our @EXPORT = qw(

46

%sd

47

%qualifiers

48

%include

49

%helpers

50

51

$filename

52

$profiledir

53

$parser

54

$logger

55

$UI_Mode

56

$running_under_genprof

57

58

which

59

getprofilefilename

60

get_full_path

61

fatal_error

62

get_pager

63

64

getprofileflags

65

setprofileflags

66

complain

67

enforce

68

69

autodep

70

reload

71

72

UI_GetString

73

UI_GetFile

74

UI_YesNo

75

UI_ShortMessage

76

UI_LongMessage

77

78

UI_Important

79

UI_Info

80

UI_PromptUser

81

display_changes

82

getkey

83

84

do_logprof_pass

85

86

loadincludes

87

readprofile

88

readprofiles

89

writeprofile

90

serialize_profile

91

attach_profile_data

92

parse_repo_profile

93

activate_repo_profiles

94

95

check_for_subdomain

96

97

setup_yast

98

shutdown_yast

99

GetDataFromYast

100

SendDataToYast

101

102

checkProfileSyntax

103

checkIncludeSyntax

104

check_qualifiers

105

106

isSkippableFile

107

isSkippableDir

108

);

109

110

our $confdir = "/etc/apparmor";

111

112

our $running_under_genprof = 0;

113

114

our $DEBUGGING;

115

116

our $unimplemented_warning = 0;

117

118

# keep track of if we're running under yast or not - default to text mode

119

our $UI_Mode = "text";

120

121

our $sevdb;

122

123

# initialize Term::ReadLine if it's available

124

our $term;

125

eval {

126

require Term::ReadLine;

127

import Term::ReadLine;

128

$term = new Term::ReadLine 'AppArmor';

129

};

130

131

# initialize the local poo

132

setlocale(LC_MESSAGES, "")

133

unless defined(LC_MESSAGES);

134

textdomain("apparmor-utils");

135

136

# where do we get our log messages from?

137

our $filename;

138

139

our $cfg;

140

our $repo_cfg;

141

142

our $parser;

143

our $ldd;

144

our $logger;

145

our $profiledir;

146

our $extraprofiledir;

147

148

# we keep track of the included profile fragments with %include

149

my %include;

150

151

my %existing_profiles;

152

153

our $seenevents = 0;

154

155

156

# these are globs that the user specifically entered. we'll keep track of

157

# them so that if one later matches, we'll suggest it again.

158

our @userglobs;

159

160

### THESE VARIABLES ARE USED WITHIN LOGPROF

161

our %t;

162

our %transitions;

163

our %sd; # we keep track of the original profiles in %sd

164

our %original_sd;

165

our %extras; # inactive profiles from extras

166

167

my @log;

168

my %pid;

169

170

my %seen;

171

my %profilechanges;

172

my %prelog;

173

my %log;

174

my %changed;

175

my @created;

176

my %skip;

177

our %helpers; # we want to preserve this one between passes

178

179

### THESE VARIABLES ARE USED WITHIN LOGPROF

180

181

my %filelist; # file level stuff including variables in config files

182

183

my $AA_MAY_EXEC = 1;

184

my $AA_MAY_WRITE = 2;

185

my $AA_MAY_READ = 4;

186

my $AA_MAY_APPEND = 8;

187

my $AA_MAY_LINK = 16;

188

my $AA_MAY_LOCK = 32;

189

my $AA_EXEC_MMAP = 64;

190

my $AA_EXEC_UNSAFE = 128;

191

my $AA_EXEC_INHERIT = 256;

192

my $AA_EXEC_UNCONFINED = 512;

193

my $AA_EXEC_PROFILE = 1024;

194

my $AA_EXEC_CHILD = 2048;

195

my $AA_EXEC_NT = 4096;

196

my $AA_LINK_SUBSET = 8192;

197

198

my $AA_OTHER_SHIFT = 14;

199

my $AA_USER_MASK = 16384 -1;

200

201

my $AA_EXEC_TYPE = $AA_MAY_EXEC | $AA_EXEC_UNSAFE | $AA_EXEC_INHERIT |

202

$AA_EXEC_UNCONFINED | $AA_EXEC_PROFILE | $AA_EXEC_CHILD | $AA_EXEC_NT;

203

204

my $ALL_AA_EXEC_TYPE = $AA_EXEC_TYPE;

205

206

my %MODE_HASH = (

207

x => $AA_MAY_EXEC,

208

X => $AA_MAY_EXEC,

209

w => $AA_MAY_WRITE,

210

W => $AA_MAY_WRITE,

211

r => $AA_MAY_READ,

212

R => $AA_MAY_READ,

213

a => $AA_MAY_APPEND,

214

A => $AA_MAY_APPEND,

215

l => $AA_MAY_LINK,

216

L => $AA_MAY_LINK,

217

k => $AA_MAY_LOCK,

218

K => $AA_MAY_LOCK,

219

m => $AA_EXEC_MMAP,

220

M => $AA_EXEC_MMAP,

221

# Unsafe => 128,

222

i => $AA_EXEC_INHERIT,

223

I => $AA_EXEC_INHERIT,

224

u => $AA_EXEC_UNCONFINED + $AA_EXEC_UNSAFE, # U + Unsafe

225

U => $AA_EXEC_UNCONFINED,

226

p => $AA_EXEC_PROFILE + $AA_EXEC_UNSAFE, # P + Unsafe

227

P => $AA_EXEC_PROFILE,

228

c => $AA_EXEC_CHILD + $AA_EXEC_UNSAFE,

229

C => $AA_EXEC_CHILD,

230

n => $AA_EXEC_NT + $AA_EXEC_UNSAFE,

231

N => $AA_EXEC_NT,

232

);

233

234

235

# Currently only used by netdomain but there's no reason it couldn't

236

# be extended to support other types.

237

my %operation_types = (

238

239

# Old socket names

240

"socket_create", => "net",

241

"socket_post_create" => "net",

242

"socket_bind" => "net",

243

"socket_connect" => "net",

244

"socket_listen" => "net",

245

"socket_accept" => "net",

246

"socket_sendmsg" => "net",

247

"socket_recvmsg" => "net",

248

"socket_getsockname" => "net",

249

"socket_getpeername" => "net",

250

"socket_getsockopt" => "net",

251

"socket_setsockopt" => "net",

252

"socket_shutdown" => "net",

253

254

# New socket names

255

"create" => "net",

256

"post_create" => "net",

257

"bind" => "net",

258

"connect" => "net",

259

"listen" => "net",

260

"accept" => "net",

261

"sendmsg" => "net",

262

"recvmsg" => "net",

263

"getsockname" => "net",

264

"getpeername" => "net",

265

"getsockopt" => "net",

266

"setsockopt" => "net",

267

"sock_shutdown" => "net",

268

);

269

270

sub optype($) {

271

my $op = shift;

272

my $type = $operation_types{$op};

273

274

return "unknown" if !defined($type);

275

return $type;

276

}

277

278

sub debug ($) {

279

my $message = shift;

280

chomp($message);

281

282

print DEBUG "$message\n" if $DEBUGGING;

283

}

284

285

my %arrows = ( A => "UP", B => "DOWN", C => "RIGHT", D => "LEFT" );

286

287

sub getkey() {

288

# change to raw mode

289

ReadMode(4);

290

291

my $key = ReadKey(0);

292

293

# decode arrow key control sequences

294

if ($key eq "\x1B") {

295

$key = ReadKey(0);

296

if ($key eq "[") {

297

$key = ReadKey(0);

298

if ($arrows{$key}) {

299

$key = $arrows{$key};

300

}

301

}

302

}

303

304

# return to cooked mode

305

ReadMode(0);

306

return $key;

307

}

308

309

BEGIN {

310

# set things up to log extra info if they want...

311

if ($ENV{LOGPROF_DEBUG}) {

312

$DEBUGGING = 1;

313

open(DEBUG, ">>$ENV{LOGPROF_DEBUG}");

314

my $oldfd = select(DEBUG);

315

$| = 1;

316

select($oldfd);

317

} else {

318

$DEBUGGING = 0;

319

}

320

}

321

322

END {

323

$DEBUGGING && debug "Exiting...";

324

325

# close the debug log if necessary

326

close(DEBUG) if $DEBUGGING;

327

}

328

329

# returns true if the specified program contains references to LD_PRELOAD or

330

# LD_LIBRARY_PATH to give the PX/UX code better suggestions

331

sub check_for_LD_XXX ($) {

332

my $file = shift;

333

334

return undef unless -f $file;

335

336

# limit our checking to programs/scripts under 10k to speed things up a bit

337

my $size = -s $file;

338

return undef unless ($size && $size < 10000);

339

340

my $found = undef;

341

if (open(F, $file)) {

342

while (<F>) {

343

$found = 1 if /LD_(PRELOAD|LIBRARY_PATH)/;

344

}

345

close(F);

346

}

347

348

return $found;

349

}

350

351

sub fatal_error ($) {

352

my $message = shift;

353

354

my $details = "$message\n";

355

356

if ($DEBUGGING) {

357

358

# we'll include the stack backtrace if we're debugging...

359

$details = Carp::longmess($message);

360

361

# write the error to the log

362

print DEBUG $details;

363

}

364

365

# we'll just shoot ourselves in the head if it was one of the yast

366

# interface functions that ran into an error. it gets really ugly if

367

# the yast frontend goes away and we try to notify the user of that

368

# problem by trying to send the yast frontend a pretty dialog box

369

my $caller = (caller(1))[3];

370

371

exit 1 if defined($caller) && $caller =~ /::(Send|Get)Data(To|From)Yast$/;

372

373

# tell the user what the hell happened

374

UI_Important($details);

375

376

# make sure the frontend exits cleanly...

377

shutdown_yast();

378

379

# die a horrible flaming death

380

exit 1;

381

}

382

383

sub setup_yast() {

384

385

# set up the yast connection if we're running under yast...

386

if ($ENV{YAST_IS_RUNNING}) {

387

388

# load the yast module if available.

389

eval { require ycp; };

390

unless ($@) {

391

import ycp;

392

393

$UI_Mode = "yast";

394

395

# let the frontend know that we're starting

396

SendDataToYast({

397

type => "initial_handshake",

398

status => "backend_starting"

399

});

400

401

# see if the frontend is just starting up also...

402

my ($ypath, $yarg) = GetDataFromYast();

403

unless ($yarg

404

&& (ref($yarg) eq "HASH")

405

&& ($yarg->{type} eq "initial_handshake")

406

&& ($yarg->{status} eq "frontend_starting"))

407

{

408

409

# something's broken, die a horrible, painful death

410

fatal_error "Yast frontend is out of sync from backend agent.";

411

}

412

$DEBUGGING && debug "Initial handshake ok";

413

414

# the yast connection seems to be working okay

415

return 1;

416

}

417

418

}

419

420

# couldn't init yast

421

return 0;

422

}

423

424

sub shutdown_yast() {

425

if ($UI_Mode eq "yast") {

426

SendDataToYast({ type => "final_shutdown" });

427

my ($ypath, $yarg) = GetDataFromYast();

428

}

429

}

430

431

sub check_for_subdomain () {

432

433

my ($support_subdomainfs, $support_securityfs);

434

if (open(MOUNTS, "/proc/filesystems")) {

435

while (<MOUNTS>) {

436

$support_subdomainfs = 1 if m/subdomainfs/;

437

$support_securityfs = 1 if m/securityfs/;

438

}

439

close(MOUNTS);

440

}

441

442

my $sd_mountpoint = "";

443

if (open(MOUNTS, "/proc/mounts")) {

444

while (<MOUNTS>) {

445

if ($support_subdomainfs) {

446

$sd_mountpoint = $1 if m/^\S+\s+(\S+)\s+subdomainfs\s/;

447

} elsif ($support_securityfs) {

448

if (m/^\S+\s+(\S+)\s+securityfs\s/) {

449

if (-e "$1/apparmor") {

450

$sd_mountpoint = "$1/apparmor";

451

} elsif (-e "$1/subdomain") {

452

$sd_mountpoint = "$1/subdomain";

453

}

454

}

455

}

456

}

457

close(MOUNTS);

458

}

459

460

# make sure that subdomain is actually mounted there

461

$sd_mountpoint = undef unless -f "$sd_mountpoint/profiles";

462

463

return $sd_mountpoint;

464

}

465

466

sub check_for_apparmor () {

467

return check_for_subdomain();

468

}

469

470

sub which ($) {

471

my $file = shift;

472

473

foreach my $dir (split(/:/, $ENV{PATH})) {

474

return "$dir/$file" if -x "$dir/$file";

475

}

476

477

return undef;

478

}

479

480

# we need to convert subdomain regexps to perl regexps

481

sub convert_regexp ($) {

482

my $regexp = shift;

483

484

# escape regexp-special characters we don't support

485

$regexp =~ s/(?<!\\)(\.|\+|\$)/\\$1/g;

486

487

# * and ** globs can't collapse to match an empty string when they're

488

# the only part of the glob at a specific directory level, which

489

# complicates things a little.

490

491

# ** globs match multiple directory levels

492

$regexp =~ s{(?<!\\)\*\*+}{

493

my ($pre, $post) = ($`, $');

494

if (($pre =~ /\/$/) && (!$post || $post =~ /^\//)) {

495

'SD_INTERNAL_MULTI_REQUIRED';

496

} else {

497

'SD_INTERNAL_MULTI_OPTIONAL';

498

}

499

}gex;

500

501

# convert * globs to match anything at the current path level

502

$regexp =~ s{(?<!\\)\*}{

503

my ($pre, $post) = ($`, $');

504

if (($pre =~ /\/$/) && (!$post || $post =~ /^\//)) {

505

'SD_INTERNAL_SINGLE_REQUIRED';

506

} else {

507

'SD_INTERNAL_SINGLE_OPTIONAL';

508

}

509

}gex;

510

511

# convert ? globs to match a single character at current path level

512

$regexp =~ s/(?<!\\)\?/[^\/]/g;

513

514

# convert {foo,baz} to (foo|baz)

515

$regexp =~ y/\{\}\,/\|/ if $regexp =~ /\{.*\,.*\}/;

516

517

# convert internal markers to their appropriate regexp equivalents

518

$regexp =~ s/SD_INTERNAL_SINGLE_OPTIONAL/[^\/]*/g;

519

$regexp =~ s/SD_INTERNAL_SINGLE_REQUIRED/[^\/]+/g;

520

$regexp =~ s/SD_INTERNAL_MULTI_OPTIONAL/.*/g;

521

$regexp =~ s/SD_INTERNAL_MULTI_REQUIRED/[^\/].*/g;

522

523

return $regexp;

524

}

525

526

sub get_full_path ($) {

527

my $originalpath = shift;

528

529

my $path = $originalpath;

530

531

# keep track so we can break out of loops

532

my $linkcount = 0;

533

534

# if we don't have any directory foo, look in the current dir

535

$path = cwd() . "/$path" if $path !~ m/\//;

536

537

# beat symlinks into submission

538

while (-l $path) {

539

540

if ($linkcount++ > 64) {

541

fatal_error "Followed too many symlinks resolving $originalpath";

542

}

543

544

# split out the directory/file components

545

if ($path =~ m/^(.*)\/(.+)$/) {

546

my ($dir, $file) = ($1, $2);

547

548

# figure out where the link is pointing...

549

my $link = readlink($path);

550

if ($link =~ /^\//) {

551

# if it's an absolute link, just replace it

552

$path = $link;

553

} else {

554

# if it's relative, let abs_path handle it

555

$path = $dir . "/$link";

556

}

557

}

558

}

559

560

return realpath($path);

561

}

562

563

sub findexecutable ($) {

564

my $bin = shift;

565

566

my $fqdbin;

567

if (-e $bin) {

568

$fqdbin = get_full_path($bin);

569

chomp($fqdbin);

570

} else {

571

if ($bin !~ /\//) {

572

my $which = which($bin);

573

if ($which) {

574

$fqdbin = get_full_path($which);

575

}

576

}

577

}

578

579

unless ($fqdbin && -e $fqdbin) {

580

return undef;

581

}

582

583

return $fqdbin;

584

}

585

586

sub name_to_prof_filename($) {

587

my $bin = shift;

588

my $filename;

589

590

unless ($bin =~ /^($profiledir)/) {

591

my $fqdbin = findexecutable($bin);

592

if ($fqdbin) {

593

$filename = getprofilefilename($fqdbin);

594

return ($filename, $fqdbin) if -f $filename;

595

}

596

}

597

598

if ($bin =~ /^$profiledir(.*)/) {

599

my $profile = $1;

600

return ($bin, $profile);

601

} elsif ($bin =~ /^\//) {

602

$filename = getprofilefilename($bin);

603

return ($filename, $bin);

604

} else {

605

# not an absolute path try it as a profile_

606

$bin = $1 if ($bin !~ /^profile_(.*)/);

607

$filename = getprofilefilename($bin);

608

return ($filename, "profile_${bin}");

609

}

610

return undef;

611

}

612

613

sub complain ($) {

614

my $bin = shift;

615

616

return if (!$bin);

617

618

my ($filename, $name) = name_to_prof_filename($bin)

619

or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));

620

621

UI_Info(sprintf(gettext('Setting %s to complain mode.'), $name));

622

623

setprofileflags($filename, "complain");

624

}

625

626

sub enforce ($) {

627

my $bin = shift;

628

629

return if (!$bin);

630

631

my ($filename, $name) = name_to_prof_filename($bin)

632

or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));

633

634

UI_Info(sprintf(gettext('Setting %s to enforce mode.'), $name));

635

636

setprofileflags($filename, "");

637

}

638

639

sub head ($) {

640

my $file = shift;

641

642

my $first = "";

643

if (open(FILE, $file)) {

644

$first = <FILE>;

645

close(FILE);

646

}

647

648

return $first;

649

}

650

651

sub get_output ($@) {

652

my ($program, @args) = @_;

653

654

my $ret = -1;

655

656

my $pid;

657

my @output;

658

659

if (-x $program) {

660

$pid = open(KID_TO_READ, "-|");

661

unless (defined $pid) {

662

fatal_error "can't fork: $!";

663

}

664

665

if ($pid) {

666

while (<KID_TO_READ>) {

667

chomp;

668

push @output, $_;

669

}

670

close(KID_TO_READ);

671

$ret = $?;

672

} else {

673

($>, $)) = ($<, $();

674

open(STDERR, ">&STDOUT")

675

|| fatal_error "can't dup stdout to stderr";

676

exec($program, @args) || fatal_error "can't exec program: $!";

677

678

# NOTREACHED

679

}

680

}

681

682

return ($ret, @output);

683

}

684

685

sub get_reqs ($) {

686

my $file = shift;

687

688

my @reqs;

689

my ($ret, @ldd) = get_output($ldd, $file);

690

691

if ($ret == 0) {

692

for my $line (@ldd) {

693

last if $line =~ /not a dynamic executable/;

694

last if $line =~ /cannot read header/;

695

last if $line =~ /statically linked/;

696

697

# avoid new kernel 2.6 poo

698

next if $line =~ /linux-(gate|vdso(32|64)).so/;

699

700

if ($line =~ /^\s*\S+ => (\/\S+)/) {

701

push @reqs, $1;

702

} elsif ($line =~ /^\s*(\/\S+)/) {

703

push @reqs, $1;

704

}

705

}

706

}

707

708

return @reqs;

709

}

710

711

sub handle_binfmt ($$) {

712

my ($profile, $fqdbin) = @_;

713

714

my %reqs;

715

my @reqs = get_reqs($fqdbin);

716

717

while (my $library = shift @reqs) {

718

719

$library = get_full_path($library);

720

721

push @reqs, get_reqs($library) unless $reqs{$library}++;

722

723

# does path match anything pulled in by includes in original profile?

724

my $combinedmode = match_prof_incs_to_path($profile, 'allow', $library);

725

726

# if we found any matching entries, do the modes match?

727

next if $combinedmode;

728

729

$library = globcommon($library);

730

chomp $library;

731

next unless $library;

732

733

$profile->{allow}{path}->{$library}{mode} |= str_to_mode("mr");

734

$profile->{allow}{path}->{$library}{audit} |= 0;

735

}

736

}

737

738

sub get_inactive_profile($) {

739

my $fqdbin = shift;

740

if ( $extras{$fqdbin} ) {

741

return {$fqdbin => $extras{$fqdbin}};

742

}

743

}

744

745

746

747

sub create_new_profile($) {

748

my $fqdbin = shift;

749

750

my $profile;

751

if ($fqdbin =~ /^\// ) {

752

$profile = {

753

$fqdbin => {

754

flags => "complain",

755

include => { "abstractions/base" => 1 },

756

path => { $fqdbin => { mode => str_to_mode("mr") } },

757

}

758

};

759

} else {

760

$profile = {

761

$fqdbin => {

762

flags => "complain",

763

include => { "abstractions/base" => 1 },

764

}

765

};

766

}

767

768

# if the executable exists on this system, pull in extra dependencies

769

if (-f $fqdbin) {

770

my $hashbang = head($fqdbin);

771

if ($hashbang && $hashbang =~ /^#!\s*(\S+)/) {

772

my $interpreter = get_full_path($1);

773

$profile->{$fqdbin}{allow}{path}->{$fqdbin}{mode} |= str_to_mode("r");

774

$profile->{$fqdbin}{allow}{path}->{$fqdbin}{mode} |= 0;

775

$profile->{$fqdbin}{allow}{path}->{$interpreter}{mode} |= str_to_mode("ix");

776

$profile->{$fqdbin}{allow}{path}->{$interpreter}{audit} |= 0;

777

if ($interpreter =~ /perl/) {

778

$profile->{$fqdbin}{include}->{"abstractions/perl"} = 1;

779

} elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {

780

$profile->{$fqdbin}{include}->{"abstractions/bash"} = 1;

781

} elsif ($interpreter =~ m/python/) {

782

$profile->{$fqdbin}{include}->{"abstractions/python"} = 1;

783

} elsif ($interpreter =~ m/ruby/) {

784

$profile->{$fqdbin}{include}->{"abstractions/ruby"} = 1;

785

}

786

handle_binfmt($profile->{$fqdbin}, $interpreter);

787

} else {

788

handle_binfmt($profile->{$fqdbin}, $fqdbin);

789

}

790

}

791

792

# create required infrastructure hats if it's a known change_hat app

793

for my $hatglob (keys %{$cfg->{required_hats}}) {

794

if ($fqdbin =~ /$hatglob/) {

795

for my $hat (sort split(/\s+/, $cfg->{required_hats}{$hatglob})) {

796

$profile->{$hat} = { flags => "complain" };

797

}

798

}

799

}

800

push @created, $fqdbin;

801

return { $fqdbin => $profile };

802

}

803

804

sub delete_profile ($) {

805

my $profile = shift;

806

my $profilefile = getprofilefilename( $profile );

807

if ( -e $profilefile ) {

808

unlink( $profilefile );

809

}

810

if ( defined $sd{$profile} ) {

811

delete $sd{$profile};

812

}

813

}

814

815

sub get_profile($) {

816

my $fqdbin = shift;

817

my $profile_data;

818

819

my $distro = $cfg->{repository}{distro};

820

my $repo_url = $cfg->{repository}{url};

821

my @profiles;

822

my %profile_hash;

823

824

if (repo_is_enabled()) {

825

my $results;

826

UI_BusyStart( gettext("Connecting to repository.....") );

827

828

my ($status_ok,$ret) =

829

fetch_profiles_by_name($repo_url, $distro, $fqdbin );

830

UI_BusyStop();

831

if ( $status_ok ) {

832

%profile_hash = %$ret;

833

} else {

834

my $errmsg =

835

sprintf(gettext("WARNING: Error fetching profiles from the repository:\n%s\n"),

836

$ret?$ret:gettext("UNKNOWN ERROR"));

837

UI_Important( $errmsg );

838

}

839

}

840

841

my $inactive_profile = get_inactive_profile($fqdbin);

842

if ( defined $inactive_profile && $inactive_profile ne "" ) {

843

# set the profile to complain mode

844

my $uname = gettext( "Inactive local profile for ") . $fqdbin;

845

$inactive_profile->{$fqdbin}{$fqdbin}{flags} = "complain";

846

# inactive profiles store where they came from

847

delete $inactive_profile->{$fqdbin}{$fqdbin}{filename};

848

$profile_hash{$uname} =

849

{

850

"username" => $uname,

851

"profile_type" => "INACTIVE_LOCAL",

852

"profile" => serialize_profile($inactive_profile->{$fqdbin},

853

$fqdbin

854

),

855

"profile_data" => $inactive_profile,

856

};

857

}

858

859

return undef if ( keys %profile_hash == 0 ); # No repo profiles, no inactive

860

# profile

861

my @options;

862

my @tmp_list;

863

my $preferred_present = 0;

864

my $preferred_user = $cfg->{repository}{preferred_user} || "NOVELL";

865

866

foreach my $p ( keys %profile_hash ) {

867

if ( $profile_hash{$p}->{username} eq $preferred_user ) {

868

$preferred_present = 1;

869

} else {

870

push @tmp_list, $profile_hash{$p}->{username};

871

}

872

}

873

874

if ( $preferred_present ) {

875

push @options, $preferred_user;

876

}

877

push @options, @tmp_list;

878

879

my $q = {};

880

$q->{headers} = [];

881

push @{ $q->{headers} }, gettext("Profile"), $fqdbin;

882

883

$q->{functions} = [ "CMD_VIEW_PROFILE", "CMD_USE_PROFILE",

884

"CMD_CREATE_PROFILE", "CMD_ABORT", "CMD_FINISHED" ];

885

886

$q->{default} = "CMD_VIEW_PROFILE";

887

888

$q->{options} = [@options];

889

$q->{selected} = 0;

890

891

my ($p, $ans, $arg);

892

do {

893

($ans, $arg) = UI_PromptUser($q);

894

$p = $profile_hash{$options[$arg]};

895

for (my $i = 0; $i < scalar(@options); $i++) {

896

if ($options[$i] eq $options[$arg]) {

897

$q->{selected} = $i;

898

}

899

}

900

901

if ($ans eq "CMD_VIEW_PROFILE") {

902

if ($UI_Mode eq "yast") {

903

SendDataToYast(

904

{

905

type => "dialog-view-profile",

906

user => $options[$arg],

907

profile => $p->{profile},

908

profile_type => $p->{profile_type}

909

}

910

);

911

my ($ypath, $yarg) = GetDataFromYast();

912

} else {

913

my $pager = get_pager();

914

open(PAGER, "| $pager");

915

print PAGER gettext("Profile submitted by") .

916

" $options[$arg]:\n\n" . $p->{profile} . "\n\n";

917

close(PAGER);

918

}

919

} elsif ($ans eq "CMD_USE_PROFILE") {

920

if ( $p->{profile_type} eq "INACTIVE_LOCAL" ) {

921

$profile_data = $p->{profile_data};

922

push @created, $fqdbin; # This really is ugly here

923

# need to find a better place to mark

924

# this as newly created

925

} else {

926

$profile_data =

927

parse_repo_profile($fqdbin, $repo_url, $p);

928

}

929

}

930

} until ($ans =~ /^CMD_(USE_PROFILE|CREATE_PROFILE)$/);

931

932

return $profile_data;

933

}

934

935

sub activate_repo_profiles ($$$) {

936

my ($url,$profiles,$complain) = @_;

937

938

readprofiles();

939

eval {

940

for my $p ( @$profiles ) {

941

my $pname = $p->[0];

942

my $profile_data = parse_repo_profile( $pname, $url, $p->[1] );

943

attach_profile_data(\%sd, $profile_data);

944

writeprofile($pname);

945

if ( $complain ) {

946

my $filename = getprofilefilename($pname);

947

setprofileflags($filename, "complain");

948

UI_Info(sprintf(gettext('Setting %s to complain mode.'),

949

$pname));

950

}

951

}

952

};

953

# if there were errors....

954

if ($@) {

955

$@ =~ s/\n$//;

956

print STDERR sprintf(gettext("Error activating profiles: %s\n"), $@);

957

}

958

}

959

960

sub autodep_base($$) {

961

my ($bin, $pname) = @_;

962

%extras = ();

963

964

$bin = $pname if (! $bin) && ($pname =~ /^\//);

965

966

unless ($repo_cfg || not defined $cfg->{repository}{url}) {

967

$repo_cfg = read_config("repository.conf");

968

if ( (not defined $repo_cfg->{repository}) ||

969

($repo_cfg->{repository}{enabled} eq "later") ) {

970

UI_ask_to_enable_repo();

971

}

972

}

973

974

my $fqdbin;

975

if ($bin) {

976

# findexecutable() might fail if we're running on a different system

977

# than the logs were collected on. ugly. we'll just hope for the best.

978

$fqdbin = findexecutable($bin) || $bin;

979

980

# try to make sure we have a full path in case findexecutable failed

981

return unless $fqdbin =~ /^\//;

982

983

# ignore directories

984

return if -d $fqdbin;

985

}

986

987

$pname = $fqdbin if $fqdbin;

988

989

my $profile_data;

990

991

readinactiveprofiles(); # need to read the profiles to see if an

992

# inactive local profile is present

993

$profile_data = eval { get_profile($pname) };

994

# propagate any errors we hit inside the get_profile call

995

if ($@) { die $@; }

996

997

unless ($profile_data) {

998

$profile_data = create_new_profile($pname);

999

}

1000

1001

my $file = getprofilefilename($pname);

1002

1003

# stick the profile into our data structure.

1004

attach_profile_data(\%sd, $profile_data);

1005

# and store a "clean" version also so we can display the changes we've

1006

# made during this run

1007

attach_profile_data(\%original_sd, $profile_data);

1008

1009

if (-f "$profiledir/tunables/global") {

1010

unless (exists $filelist{$file}) {

1011

$filelist{$file} = { };

1012

}

1013

$filelist{$file}{include}{'tunables/global'} = 1; # sorry

1014

}

1015

1016

# write out the profile...

1017

writeprofile_ui_feedback($pname);

1018

}

1019

1020

sub autodep ($) {

1021

my $bin = shift;

1022

return autodep_base($bin, "");

1023

}

1024

1025

sub getprofilefilename ($) {

1026

my $profile = shift;

1027

1028

my $filename = $profile;

1029

if ($filename =~ /^\//) {

1030

$filename =~ s/^\///; # strip leading /

1031

} else {

1032

$filename = "profile_$filename";

1033

}

1034

$filename =~ s/\//./g; # convert /'s to .'s

1035

1036

return "$profiledir/$filename";

1037

}

1038

1039

sub setprofileflags ($$) {

1040

my $filename = shift;

1041

my $newflags = shift;

1042

1043

if (open(PROFILE, "$filename")) {

1044

if (open(NEWPROFILE, ">$filename.new")) {

1045

while (<PROFILE>) {

1046

if (m/^(\s*)(("??\/.+?"??)|(profile\s+("??.+?"??)))\s+(flags=$.+$\s+)*\{\s*$/) {

1047

my ($space, $binary, $flags) = ($1, $2, $6);

1048

1049

if ($newflags) {

1050

$_ = "$space$binary flags=($newflags) {\n";

1051

} else {

1052

$_ = "$space$binary {\n";

1053

}

1054

} elsif (m/^(\s*\^\S+)\s+(flags=$.+$\s+)*\{\s*$/) {

1055

my ($hat, $flags) = ($1, $2);

1056

1057

if ($newflags) {

1058

$_ = "$hat flags=($newflags) {\n";

1059

} else {

1060

$_ = "$hat {\n";

1061

}

1062

}

1063

print NEWPROFILE;

1064

}

1065

close(NEWPROFILE);

1066

rename("$filename.new", "$filename");

1067

}

1068

close(PROFILE);

1069

}

1070

}

1071

1072

sub profile_exists($) {

1073

my $program = shift || return 0;

1074

1075

# if it's already in the cache, return true

1076

return 1 if $existing_profiles{$program};

1077

1078

# if the profile exists, mark it in the cache and return true

1079

my $profile = getprofilefilename($program);

1080

if (-e $profile) {

1081

$existing_profiles{$program} = 1;

1082

return 1;

1083

}

1084

1085

# couldn't find a profile, so we'll return false

1086

return 0;

1087

}

1088

1089

sub sync_profiles() {

1090

1091

my ($user, $pass) = get_repo_user_pass();

1092

return unless ( $user && $pass );

1093

1094

my @repo_profiles;

1095

my @changed_profiles;

1096

my @new_profiles;

1097

my $serialize_opts = { };

1098

my ($status_ok,$ret) =

1099

fetch_profiles_by_user($cfg->{repository}{url},

1100

$cfg->{repository}{distro},

1101

$user

1102

);

1103

if ( !$status_ok ) {

1104

my $errmsg =

1105

sprintf(gettext("WARNING: Error syncronizing profiles with the repository:\n%s\n"),

1106

$ret?$ret:gettext("UNKNOWN ERROR"));

1107

UI_Important($errmsg);

1108

return;

1109

} else {

1110

my $users_repo_profiles = $ret;

1111

$serialize_opts->{NO_FLAGS} = 1;

1112

#

1113

# Find changes made to non-repo profiles

1114

#

1115

for my $profile (sort keys %sd) {

1116

if (is_repo_profile($sd{$profile}{$profile})) {

1117

push @repo_profiles, $profile;

1118

}

1119

if ( grep(/^$profile$/, @created) ) {

1120

my $p_local = serialize_profile($sd{$profile},

1121

$profile,

1122

$serialize_opts);

1123

if ( not defined $users_repo_profiles->{$profile} ) {

1124

push @new_profiles, [ $profile, $p_local, "" ];

1125

} else {

1126

my $p_repo = $users_repo_profiles->{$profile}->{profile};

1127

if ( $p_local ne $p_repo ) {

1128

push @changed_profiles, [ $profile, $p_local, $p_repo ];

1129

}

1130

}

1131

}

1132

}

1133

1134

#

1135

# Find changes made to local profiles with repo metadata

1136

#

1137

if (@repo_profiles) {

1138

for my $profile (@repo_profiles) {

1139

my $p_local = serialize_profile($sd{$profile},

1140

$profile,

1141

$serialize_opts);

1142

if ( not exists $users_repo_profiles->{$profile} ) {

1143

push @new_profiles, [ $profile, $p_local, "" ];

1144

} else {

1145

my $p_repo = "";

1146

if ( $sd{$profile}{$profile}{repo}{user} eq $user ) {

1147

$p_repo = $users_repo_profiles->{$profile}->{profile};

1148

} else {

1149

my ($status_ok,$ret) =

1150

fetch_profile_by_id($cfg->{repository}{url},

1151

$sd{$profile}{$profile}{repo}{id}

1152

);

1153

if ( $status_ok ) {

1154

$p_repo = $ret->{profile};

1155

} else {

1156

my $errmsg =

1157

sprintf(

1158

gettext("WARNING: Error syncronizing profiles with the repository:\n%s\n"),

1159

$ret?$ret:gettext("UNKNOWN ERROR"));

1160

UI_Important($errmsg);

1161

next;

1162

}

1163

}

1164

if ( $p_repo ne $p_local ) {

1165

push @changed_profiles, [ $profile, $p_local, $p_repo ];

1166

}

1167

}

1168

}

1169

}

1170

1171

if ( @changed_profiles ) {

1172

submit_changed_profiles( \@changed_profiles );

1173

}

1174

if ( @new_profiles ) {

1175

submit_created_profiles( \@new_profiles );

1176

}

1177

}

1178

}

1179

1180

sub submit_created_profiles($) {

1181

my $new_profiles = shift;

1182

my $url = $cfg->{repository}{url};

1183

1184

if ($UI_Mode eq "yast") {

1185

my $title = gettext("New profiles");

1186

my $explanation =

1187

gettext("Please choose the newly created profiles that you would".

1188

" like\nto store in the repository");

1189

yast_select_and_upload_profiles($title,

1190

$explanation,

1191

$new_profiles);

1192

} else {

1193

my $title =

1194

gettext("Submit newly created profiles to the repository");

1195

my $explanation =

1196

gettext("Would you like to upload the newly created profiles?");

1197

console_select_and_upload_profiles($title,

1198

$explanation,

1199

$new_profiles);

1200

}

1201

}

1202

1203

sub submit_changed_profiles($) {

1204

my $changed_profiles = shift;

1205

my $url = $cfg->{repository}{url};

1206

if (@$changed_profiles) {

1207

if ($UI_Mode eq "yast") {

1208

my $explanation =

1209

gettext("Select which of the changed profiles you would".

1210

" like to upload\nto the repository");

1211

my $title = gettext("Changed profiles");

1212

yast_select_and_upload_profiles($title,

1213

$explanation,

1214

$changed_profiles);

1215

} else {

1216

my $title =

1217

gettext("Submit changed profiles to the repository");

1218

my $explanation =

1219

gettext("The following profiles from the repository were".

1220

" changed.\nWould you like to upload your changes?");

1221

console_select_and_upload_profiles($title,

1222

$explanation,

1223

$changed_profiles);

1224

}

1225

}

1226

}

1227

1228

sub yast_select_and_upload_profiles($$$) {

1229

1230

my ($title, $explanation, $profiles_ref) = @_;

1231

my $url = $cfg->{repository}{url};

1232

my %profile_changes;

1233

my @profiles = @$profiles_ref;

1234

1235

foreach my $prof (@profiles) {

1236

$profile_changes{ $prof->[0] } =

1237

get_profile_diff($prof->[2], $prof->[1]);

1238

}

1239

1240

my (@selected_profiles, $changelog, $changelogs, $single_changelog);

1241

SendDataToYast(

1242

{

1243

type => "dialog-select-profiles",

1244

title => $title,

1245

explanation => $explanation,

1246

default_select => "false",

1247

disable_ask_upload => "true",

1248

profiles => \%profile_changes

1249

}

1250

);

1251

my ($ypath, $yarg) = GetDataFromYast();

1252

if ($yarg->{STATUS} eq "cancel") {

1253

return;

1254

} else {

1255

my $selected_profiles_ref = $yarg->{PROFILES};

1256

@selected_profiles = @$selected_profiles_ref;

1257

$changelogs = $yarg->{CHANGELOG};

1258

if (defined $changelogs->{SINGLE_CHANGELOG}) {

1259

$changelog = $changelogs->{SINGLE_CHANGELOG};

1260

$single_changelog = 1;

1261

}

1262

}

1263

1264

for my $profile (@selected_profiles) {

1265

my ($user, $pass) = get_repo_user_pass();

1266

my $profile_string = serialize_profile($sd{$profile}, $profile);

1267

if (!$single_changelog) {

1268

$changelog = $changelogs->{$profile};

1269

}

1270

my ($status_ok, $ret) = upload_profile( $url,

1271

$user,

1272

$pass,

1273

$cfg->{repository}{distro},

1274

$profile,

1275

$profile_string,

1276

$changelog

1277

);

1278

if ($status_ok) {

1279

my $newprofile = $ret;

1280

my $newid = $newprofile->{id};

1281

set_repo_info($sd{$profile}{$profile}, $url, $user, $newid);

1282

writeprofile_ui_feedback($profile);

1283

} else {

1284

my $errmsg =

1285

sprintf(

1286

gettext("WARNING: An error occured while uploading the profile %s\n%s\n"),

1287

$profile, $ret?$ret:gettext("UNKNOWN ERROR"));

1288

UI_Important( $errmsg );

1289

}

1290

}

1291

UI_Info(gettext("Uploaded changes to repository."));

1292

1293

# Check to see if unselected profiles should be marked as local only

1294

# this is outside of the main repo code as we want users to be able to mark

1295

# profiles as local only even if they aren't able to connect to the repo.

1296

if (defined $yarg->{NEVER_ASK_AGAIN}) {

1297

my @unselected_profiles;

1298

foreach my $prof (@profiles) {

1299

if ( grep(/^$prof->[0]$/, @selected_profiles) == 0 ) {

1300

push @unselected_profiles, $prof->[0];

1301

}

1302

}

1303

set_profiles_local_only( @unselected_profiles );

1304

}

1305

}

1306

1307

sub console_select_and_upload_profiles($$$) {

1308

my ($title, $explanation, $profiles_ref) = @_;

1309

my $url = $cfg->{repository}{url};

1310

my @profiles = @$profiles_ref;

1311

my $q = {};

1312

$q->{title} = $title;

1313

$q->{headers} = [ gettext("Repository"), $url, ];

1314

1315

$q->{explanation} = $explanation;

1316

1317

$q->{functions} = [ "CMD_UPLOAD_CHANGES",

1318

"CMD_VIEW_CHANGES",

1319

"CMD_ASK_LATER",

1320

"CMD_ASK_NEVER",

1321

"CMD_ABORT", ];

1322

1323

$q->{default} = "CMD_VIEW_CHANGES";

1324

1325

$q->{options} = [ map { $_->[0] } @profiles ];

1326

$q->{selected} = 0;

1327

1328

my ($ans, $arg);

1329

do {

1330

($ans, $arg) = UI_PromptUser($q);

1331

1332

if ($ans eq "CMD_VIEW_CHANGES") {

1333

display_changes($profiles[$arg]->[2], $profiles[$arg]->[1]);

1334

}

1335

} until $ans =~ /^CMD_(UPLOAD_CHANGES|ASK_NEVER|ASK_LATER)/;

1336

1337

if ($ans eq "CMD_ASK_NEVER") {

1338

set_profiles_local_only( map { $_->[0] } @profiles );

1339

} elsif ($ans eq "CMD_UPLOAD_CHANGES") {

1340

my $changelog = UI_GetString(gettext("Changelog Entry: "), "");

1341

my ($user, $pass) = get_repo_user_pass();

1342

if ($user && $pass) {

1343

for my $p_data (@profiles) {

1344

my $profile = $p_data->[0];

1345

my $profile_string = $p_data->[1];

1346

my ($status_ok,$ret) =

1347

upload_profile( $url,

1348

$user,

1349

$pass,

1350

$cfg->{repository}{distro},

1351

$profile,

1352

$profile_string,

1353

$changelog

1354

);

1355

if ($status_ok) {

1356

my $newprofile = $ret;

1357

my $newid = $newprofile->{id};

1358

set_repo_info($sd{$profile}{$profile}, $url, $user, $newid);

1359

writeprofile_ui_feedback($profile);

1360

UI_Info(

1361

sprintf(gettext("Uploaded %s to repository."), $profile)

1362

);

1363

} else {

1364

my $errmsg =

1365

sprintf(

1366

gettext("WARNING: An error occured while uploading the profile %s\n%s\n"),

1367

$profile, $ret?$ret:gettext("UNKNOWN ERROR"));

1368

UI_Important( $errmsg );

1369

}

1370

}

1371

} else {

1372

UI_Important(gettext("Repository Error\n" .

1373

"Registration or Signin was unsuccessful. User login\n" .

1374

"information is required to upload profiles to the\n" .

1375

"repository. These changes have not been sent.\n"));

1376

}

1377

}

1378

}

1379

1380

#

1381

# Mark the profiles passed in @profiles as local only

1382

# and don't prompt to upload changes to the repository

1383

#

1384

sub set_profiles_local_only(@) {

1385

my @profiles = @_;

1386

for my $profile (@profiles) {

1387

$sd{$profile}{$profile}{repo}{neversubmit} = 1;

1388

writeprofile_ui_feedback($profile);

1389

}

1390

}

1391

1392

##########################################################################

1393

# Here are the console/yast interface functions

1394

1395

sub UI_Info ($) {

1396

my $text = shift;

1397

1398

$DEBUGGING && debug "UI_Info: $UI_Mode: $text";

1399

1400

if ($UI_Mode eq "text") {

1401

print "$text\n";

1402

} else {

1403

ycp::y2milestone($text);

1404

}

1405

}

1406

1407

sub UI_Important ($) {

1408

my $text = shift;

1409

1410

$DEBUGGING && debug "UI_Important: $UI_Mode: $text";

1411

1412

if ($UI_Mode eq "text") {

1413

print "\n$text\n";

1414

} else {

1415

SendDataToYast({ type => "dialog-error", message => $text });

1416

my ($path, $yarg) = GetDataFromYast();

1417

}

1418

}

1419

1420

sub UI_YesNo ($$) {

1421

my $text = shift;

1422

my $default = shift;

1423

1424

$DEBUGGING && debug "UI_YesNo: $UI_Mode: $text $default";

1425

1426

my $ans;

1427

if ($UI_Mode eq "text") {

1428

1429

my $yes = gettext("(Y)es");

1430

my $no = gettext("(N)o");

1431

1432

# figure out our localized hotkeys

1433

my $usrmsg = "PromptUser: " . gettext("Invalid hotkey for");

1434

$yes =~ /$(\S)$/ or fatal_error "$usrmsg '$yes'";

1435

my $yeskey = lc($1);

1436

$no =~ /$(\S)$/ or fatal_error "$usrmsg '$no'";

1437

my $nokey = lc($1);

1438

1439

print "\n$text\n";

1440

if ($default eq "y") {

1441

print "\n[$yes] / $no\n";

1442

} else {

1443

print "\n$yes / [$no]\n";

1444

}

1445

$ans = getkey() || (($default eq "y") ? $yeskey : $nokey);

1446

1447

# convert back from a localized answer to english y or n

1448

$ans = (lc($ans) eq $yeskey) ? "y" : "n";

1449

} else {

1450

1451

SendDataToYast({ type => "dialog-yesno", question => $text });

1452

my ($ypath, $yarg) = GetDataFromYast();

1453

$ans = $yarg->{answer} || $default;

1454

1455

}

1456

1457

return $ans;

1458

}

1459

1460

sub UI_YesNoCancel ($$) {

1461

my $text = shift;

1462

my $default = shift;

1463

1464

$DEBUGGING && debug "UI_YesNoCancel: $UI_Mode: $text $default";

1465

1466

my $ans;

1467

if ($UI_Mode eq "text") {

1468

1469

my $yes = gettext("(Y)es");

1470

my $no = gettext("(N)o");

1471

my $cancel = gettext("(C)ancel");

1472

1473

# figure out our localized hotkeys

1474

my $usrmsg = "PromptUser: " . gettext("Invalid hotkey for");

1475

$yes =~ /$(\S)$/ or fatal_error "$usrmsg '$yes'";

1476

my $yeskey = lc($1);

1477

$no =~ /$(\S)$/ or fatal_error "$usrmsg '$no'";

1478

my $nokey = lc($1);

1479

$cancel =~ /$(\S)$/ or fatal_error "$usrmsg '$cancel'";

1480

my $cancelkey = lc($1);

1481

1482

$ans = "XXXINVALIDXXX";

1483

while ($ans !~ /^(y|n|c)$/) {

1484

print "\n$text\n";

1485

if ($default eq "y") {

1486

print "\n[$yes] / $no / $cancel\n";

1487

} elsif ($default eq "n") {

1488

print "\n$yes / [$no] / $cancel\n";

1489

} else {

1490

print "\n$yes / $no / [$cancel]\n";

1491

}

1492

1493

$ans = getkey();

1494

1495

if ($ans) {

1496

# convert back from a localized answer to english y or n

1497

$ans = lc($ans);

1498

if ($ans eq $yeskey) {

1499

$ans = "y";

1500

} elsif ($ans eq $nokey) {

1501

$ans = "n";

1502

} elsif ($ans eq $cancelkey) {

1503

$ans = "c";

1504

}

1505

} else {

1506

$ans = $default;

1507

}

1508

}

1509

} else {

1510

1511

SendDataToYast({ type => "dialog-yesnocancel", question => $text });

1512

my ($ypath, $yarg) = GetDataFromYast();

1513

$ans = $yarg->{answer} || $default;

1514

1515

}

1516

1517

return $ans;

1518

}

1519

1520

sub UI_GetString ($$) {

1521

my $text = shift;

1522

my $default = shift;

1523

1524

$DEBUGGING && debug "UI_GetString: $UI_Mode: $text $default";

1525

1526

my $string;

1527

if ($UI_Mode eq "text") {

1528

1529

if ($term) {

1530

$string = $term->readline($text, $default);

1531

} else {

1532

local $| = 1;

1533

print "$text";

1534

$string = <STDIN>;

1535

chomp($string);

1536

}

1537

1538

} else {

1539

1540

SendDataToYast({

1541

type => "dialog-getstring",

1542

label => $text,

1543

default => $default

1544

});

1545

my ($ypath, $yarg) = GetDataFromYast();

1546

$string = $yarg->{string};

1547

1548

}

1549

return $string;

1550

}

1551

1552

sub UI_GetFile ($) {

1553

my $f = shift;

1554

1555

$DEBUGGING && debug "UI_GetFile: $UI_Mode";

1556

1557

my $filename;

1558

if ($UI_Mode eq "text") {

1559

1560

local $| = 1;

1561

print "$f->{description}\n";

1562

$filename = <STDIN>;

1563

chomp($filename);

1564

1565

} else {

1566

1567

$f->{type} = "dialog-getfile";

1568

1569

SendDataToYast($f);

1570

my ($ypath, $yarg) = GetDataFromYast();

1571

if ($yarg->{answer} eq "okay") {

1572

$filename = $yarg->{filename};

1573

}

1574

}

1575

1576

return $filename;

1577

}

1578

1579

sub UI_BusyStart ($) {

1580

my $message = shift;

1581

$DEBUGGING && debug "UI_BusyStart: $UI_Mode";

1582

1583

if ($UI_Mode eq "text") {

1584

UI_Info( $message );

1585

} else {

1586

SendDataToYast({

1587

type => "dialog-busy-start",

1588

message => $message,

1589

});

1590

my ($ypath, $yarg) = GetDataFromYast();

1591

}

1592

}

1593

1594

sub UI_BusyStop() {

1595

$DEBUGGING && debug "UI_BusyStop: $UI_Mode";

1596

1597

if ($UI_Mode ne "text") {

1598

SendDataToYast({ type => "dialog-busy-stop" });

1599

my ($ypath, $yarg) = GetDataFromYast();

1600

}

1601

}

1602

1603

1604

my %CMDS = (

1605

CMD_ALLOW => "(A)llow",

1606

CMD_OTHER => "(M)ore",

1607

CMD_AUDIT_NEW => "Audi(t)",

1608

CMD_AUDIT_OFF => "Audi(t) off",

1609

CMD_AUDIT_FULL => "Audit (A)ll",

1610

CMD_OTHER => "(O)pts",

1611

CMD_USER_ON => "(O)wner permissions on",

1612

CMD_USER_OFF => "(O)wner permissions off",

1613

CMD_DENY => "(D)eny",

1614

CMD_ABORT => "Abo(r)t",

1615

CMD_FINISHED => "(F)inish",

1616

CMD_ix => "(I)nherit",

1617

CMD_px => "(P)rofile",

1618

CMD_px_safe => "(P)rofile Clean Exec",

1619

CMD_cx => "(C)hild",

1620

CMD_cx_safe => "(C)hild Clean Exec",

1621

CMD_nx => "(N)ame",

1622

CMD_nx_safe => "(N)amed Clean Exec",

1623

CMD_ux => "(U)nconfined",

1624

CMD_ux_safe => "(U)nconfined Clean Exec",

1625

CMD_pix => "(P)rofile ix",

1626

CMD_pix_safe => "(P)rofile ix Clean Exec",

1627

CMD_cix => "(C)hild ix",

1628

CMD_cix_safe => "(C)hild ix Cx Clean Exec",

1629

CMD_nix => "(N)ame ix",

1630

CMD_nix_safe => "(N)ame ix",

1631

CMD_EXEC_IX_ON => "(X)ix",

1632

CMD_EXEC_IX_OFF => "(X)ix",

1633

CMD_SAVE => "(S)ave Changes",

1634

CMD_CONTINUE => "(C)ontinue Profiling",

1635

CMD_NEW => "(N)ew",

1636

CMD_GLOB => "(G)lob",

1637

CMD_GLOBEXT => "Glob w/(E)xt",

1638

CMD_ADDHAT => "(A)dd Requested Hat",

1639

CMD_USEDEFAULT => "(U)se Default Hat",

1640

CMD_SCAN => "(S)can system log for AppArmor events",

1641

CMD_HELP => "(H)elp",

1642

CMD_VIEW_PROFILE => "(V)iew Profile",

1643

CMD_USE_PROFILE => "(U)se Profile",

1644

CMD_CREATE_PROFILE => "(C)reate New Profile",

1645

CMD_UPDATE_PROFILE => "(U)pdate Profile",

1646

CMD_IGNORE_UPDATE => "(I)gnore Update",

1647

CMD_SAVE_CHANGES => "(S)ave Changes",

1648

CMD_UPLOAD_CHANGES => "(U)pload Changes",

1649

CMD_VIEW_CHANGES => "(V)iew Changes",

1650

CMD_VIEW => "(V)iew",

1651

CMD_ENABLE_REPO => "(E)nable Repository",

1652

CMD_DISABLE_REPO => "(D)isable Repository",

1653

CMD_ASK_NEVER => "(N)ever Ask Again",

1654

CMD_ASK_LATER => "Ask Me (L)ater",

1655

CMD_YES => "(Y)es",

1656

CMD_NO => "(N)o",

1657

CMD_ALL_NET => "Allow All (N)etwork",

1658

CMD_NET_FAMILY => "Allow Network Fa(m)ily",

1659

CMD_OVERWRITE => "(O)verwrite Profile",

1660

CMD_KEEP => "(K)eep Profile",

1661

CMD_CONTINUE => "(C)ontinue",

1662

);

1663

1664

sub UI_PromptUser ($) {

1665

my $q = shift;

1666

1667

my ($cmd, $arg);

1668

if ($UI_Mode eq "text") {

1669

1670

($cmd, $arg) = Text_PromptUser($q);

1671

1672

} else {

1673

1674

$q->{type} = "wizard";

1675

1676

SendDataToYast($q);

1677

my ($ypath, $yarg) = GetDataFromYast();

1678

1679

$cmd = $yarg->{selection} || "CMD_ABORT";

1680

$arg = $yarg->{selected};

1681

}

1682

1683

if ($cmd eq "CMD_ABORT") {

1684

confirm_and_abort();

1685

$cmd = "XXXINVALIDXXX";

1686

} elsif ($cmd eq "CMD_FINISHED") {

1687

confirm_and_finish();

1688

$cmd = "XXXINVALIDXXX";

1689

}

1690

1691

if (wantarray) {

1692

return ($cmd, $arg);

1693

} else {

1694

return $cmd;

1695

}

1696

}

1697

1698

1699

sub UI_ShortMessage($$) {

1700

my ($headline, $message) = @_;

1701

1702

SendDataToYast(

1703

{

1704

type => "short-dialog-message",

1705

headline => $headline,

1706

message => $message

1707

}

1708

);

1709

my ($ypath, $yarg) = GetDataFromYast();

1710

}

1711

1712

sub UI_LongMessage($$) {

1713

my ($headline, $message) = @_;

1714

1715

$headline = "MISSING" if not defined $headline;

1716

$message = "MISSING" if not defined $message;

1717

1718

SendDataToYast(

1719

{

1720

type => "long-dialog-message",

1721

headline => $headline,

1722

message => $message

1723

}

1724

);

1725

my ($ypath, $yarg) = GetDataFromYast();

1726

}

1727

1728

##########################################################################

1729

# here are the interface functions to send data back and forth between

1730

# the yast frontend and the perl backend

1731

1732

# this is super ugly, but waits for the next ycp Read command and sends data

1733

# back to the ycp front end.

1734

1735

sub SendDataToYast($) {

1736

my $data = shift;

1737

1738

$DEBUGGING && debug "SendDataToYast: Waiting for YCP command";

1739

1740

while (<STDIN>) {

1741

$DEBUGGING && debug "SendDataToYast: YCP: $_";

1742

my ($ycommand, $ypath, $yargument) = ycp::ParseCommand($_);

1743

1744

if ($ycommand && $ycommand eq "Read") {

1745

1746

if ($DEBUGGING) {

1747

my $debugmsg = Data::Dumper->Dump([$data], [qw(*data)]);

1748

debug "SendDataToYast: Sending--\n$debugmsg";

1749

}

1750

1751

ycp::Return($data);

1752

return 1;

1753

1754

} else {

1755

1756

$DEBUGGING && debug "SendDataToYast: Expected 'Read' but got-- $_";

1757

1758

}

1759

}

1760

1761

# if we ever break out here, something's horribly wrong.

1762

fatal_error "SendDataToYast: didn't receive YCP command before connection died";

1763

}

1764

1765

# this is super ugly, but waits for the next ycp Write command and grabs

1766

# whatever the ycp front end gives us

1767

1768

sub GetDataFromYast() {

1769

1770

$DEBUGGING && debug "GetDataFromYast: Waiting for YCP command";

1771

1772

while (<STDIN>) {

1773

$DEBUGGING && debug "GetDataFromYast: YCP: $_";

1774

my ($ycmd, $ypath, $yarg) = ycp::ParseCommand($_);

1775

1776

if ($DEBUGGING) {

1777

my $debugmsg = Data::Dumper->Dump([$yarg], [qw(*data)]);

1778

debug "GetDataFromYast: Received--\n$debugmsg";

1779

}

1780

1781

if ($ycmd && $ycmd eq "Write") {

1782

1783

ycp::Return("true");

1784

return ($ypath, $yarg);

1785

1786

} else {

1787

$DEBUGGING && debug "GetDataFromYast: Expected 'Write' but got-- $_";

1788

}

1789

}

1790

1791

# if we ever break out here, something's horribly wrong.

1792

fatal_error "GetDataFromYast: didn't receive YCP command before connection died";

1793

}

1794

1795

sub confirm_and_abort() {

1796

my $ans = UI_YesNo(gettext("Are you sure you want to abandon this set of profile changes and exit?"), "n");

1797

if ($ans eq "y") {

1798

UI_Info(gettext("Abandoning all changes."));

1799

shutdown_yast();

1800

foreach my $prof (@created) {

1801

delete_profile($prof);

1802

}

1803

exit 0;

1804

}

1805

}

1806

1807

sub confirm_and_finish() {

1808

die "FINISHING\n";

1809

}

1810

1811

sub build_x_functions($$$) {

1812

my ($default, $options, $exec_toggle) = @_;

1813

my @{list};

1814

if ($exec_toggle) {

1815

push @list, "CMD_ix" if $options =~ /i/;

1816

push @list, "CMD_pix" if $options =~ /p/ and $options =~ /i/;

1817

push @list, "CMD_cix" if $options =~ /c/ and $options =~ /i/;

1818

push @list, "CMD_nix" if $options =~ /n/ and $options =~ /i/;

1819

push @list, "CMD_ux" if $options =~ /u/;

1820

} else {

1821

push @list, "CMD_ix" if $options =~ /i/;

1822

push @list, "CMD_px" if $options =~ /p/;

1823

push @list, "CMD_cx" if $options =~ /c/;

1824

push @list, "CMD_nx" if $options =~ /n/;

1825

push @list, "CMD_ux" if $options =~ /u/;

1826

}

1827

if ($exec_toggle) {

1828

push @list, "CMD_EXEC_IX_OFF" if $options =~/p|c|n/;

1829

} else {

1830

push @list, "CMD_EXEC_IX_ON" if $options =~/p|c|n/;

1831

}

1832

push @list, "CMD_DENY", "CMD_ABORT", "CMD_FINISHED";

1833

return @list;

1834

}

1835

1836

##########################################################################

1837

# this is the hideously ugly function that descends down the flow/event

1838

# trees that we've generated by parsing the logfile

1839

1840

sub handlechildren($$$);

1841

1842

sub handlechildren($$$) {

1843

my $profile = shift;

1844

my $hat = shift;

1845

my $root = shift;

1846

1847

my @entries = @$root;

1848

for my $entry (@entries) {

1849

fatal_error "$entry is not a ref" if not ref($entry);

1850

1851

if (ref($entry->[0])) {

1852

handlechildren($profile, $hat, $entry);

1853

} else {

1854

1855

my @entry = @$entry;

1856

my $type = shift @entry;

1857

1858

if ($type eq "fork") {

1859

my ($pid, $p, $h) = @entry;

1860

1861

if ( ($p !~ /null(-complain)*-profile/)

1862

&& ($h !~ /null(-complain)*-profile/))

1863

{

1864

$profile = $p;

1865

$hat = $h;

1866

}

1867

1868

if ($hat) {

1869

$profilechanges{$pid} = $profile . "//" . $hat;

1870

} else {

1871

$profilechanges{$pid} = $profile;

1872

}

1873

} elsif ($type eq "unknown_hat") {

1874

my ($pid, $p, $h, $sdmode, $uhat) = @entry;

1875

1876

if ($p !~ /null(-complain)*-profile/) {

1877

$profile = $p;

1878

}

1879

1880

if ($sd{$profile}{$uhat}) {

1881

$hat = $uhat;

1882

next;

1883

}

1884

1885

my $new_p = update_repo_profile($sd{$profile}{$profile});

1886

if ( $new_p and

1887

UI_SelectUpdatedRepoProfile($profile, $new_p) and

1888

$sd{$profile}{$uhat} ) {

1889

$hat = $uhat;

1890

next;

1891

}

1892

1893

# figure out what our default hat for this application is.

1894

my $defaulthat;

1895

for my $hatglob (keys %{$cfg->{defaulthat}}) {

1896

$defaulthat = $cfg->{defaulthat}{$hatglob}

1897

if $profile =~ /$hatglob/;

1898

}

1899

# keep track of previous answers for this run...

1900

my $context = $profile;

1901

$context .= " -> ^$uhat";

1902

my $ans = $transitions{$context} || "XXXINVALIDXXX";

1903

1904

while ($ans !~ /^CMD_(ADDHAT|USEDEFAULT|DENY)$/) {

1905

my $q = {};

1906

$q->{headers} = [];

1907

push @{ $q->{headers} }, gettext("Profile"), $profile;

1908

if ($defaulthat) {

1909

push @{ $q->{headers} }, gettext("Default Hat"), $defaulthat;

1910

}

1911

push @{ $q->{headers} }, gettext("Requested Hat"), $uhat;

1912

1913

$q->{functions} = [];

1914

push @{ $q->{functions} }, "CMD_ADDHAT";

1915

push @{ $q->{functions} }, "CMD_USEDEFAULT" if $defaulthat;

1916

push @{$q->{functions}}, "CMD_DENY", "CMD_ABORT",

1917

"CMD_FINISHED";

1918

1919

$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ADDHAT" : "CMD_DENY";

1920

1921

$seenevents++;

1922

1923

$ans = UI_PromptUser($q);

1924

1925

}

1926

$transitions{$context} = $ans;

1927

1928

if ($ans eq "CMD_ADDHAT") {

1929

$hat = $uhat;

1930

$sd{$profile}{$hat}{flags} = $sd{$profile}{$profile}{flags};

1931

} elsif ($ans eq "CMD_USEDEFAULT") {

1932

$hat = $defaulthat;

1933

} elsif ($ans eq "CMD_DENY") {

1934

return;

1935

}

1936

1937

} elsif ($type eq "capability") {

1938

my ($pid, $p, $h, $prog, $sdmode, $capability) = @entry;

1939

1940

if ( ($p !~ /null(-complain)*-profile/)

1941

&& ($h !~ /null(-complain)*-profile/))

1942

{

1943

$profile = $p;

1944

$hat = $h;

1945

}

1946

1947

# print "$pid $profile $hat $prog $sdmode capability $capability\n";

1948

1949

next unless $profile && $hat;

1950

1951

$prelog{$sdmode}{$profile}{$hat}{capability}{$capability} = 1;

1952

} elsif (($type eq "path") || ($type eq "exec")) {

1953

my ($pid, $p, $h, $prog, $sdmode, $mode, $detail, $to_name) = @entry;

1954

1955

$mode = 0 unless ($mode);

1956

1957

if ( ($p !~ /null(-complain)*-profile/)

1958

&& ($h !~ /null(-complain)*-profile/))

1959

{

1960

$profile = $p;

1961

$hat = $h;

1962

}

1963

1964

next unless $profile && $hat && $detail;

1965

my $domainchange = ($type eq "exec") ? "change" : "nochange";

1966

1967

# escape special characters that show up in literal paths

1968

$detail =~ s/(\[|\]|\+|\*|\{|\})/\\$1/g;

1969

1970

# we need to give the Execute dialog if they're requesting x

1971

# access for something that's not a directory - we'll force

1972

# a "ix" Path dialog for directories

1973

my $do_execute = 0;

1974

my $exec_target = $detail;

1975

1976

if ($mode & str_to_mode("x")) {

1977

if (-d $exec_target) {

1978

$mode &= (~$ALL_AA_EXEC_TYPE);

1979

$mode |= str_to_mode("ix");

1980

} else {

1981

$do_execute = 1;

1982

}

1983

}

1984

1985

if ($mode & $AA_MAY_LINK) {

1986

if ($detail =~ m/^from (.+) to (.+)$/) {

1987

my ($path, $target) = ($1, $2);

1988

1989

my $frommode = str_to_mode("lr");

1990

if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$path}) {

1991

$frommode |= $prelog{$sdmode}{$profile}{$hat}{path}{$path};

1992

}

1993

$prelog{$sdmode}{$profile}{$hat}{path}{$path} = $frommode;

1994

1995

my $tomode = str_to_mode("lr");

1996

if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$target}) {

1997

$tomode |= $prelog{$sdmode}{$profile}{$hat}{path}{$target};

1998

}

1999

$prelog{$sdmode}{$profile}{$hat}{path}{$target} = $tomode;

2000

2001

# print "$pid $profile $hat $prog $sdmode $path:$frommode -> $target:$tomode\n";

2002

} else {

2003

next;

2004

}

2005

} elsif ($mode) {

2006

my $path = $detail;

2007

2008

if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$path}) {

2009

$mode |= $prelog{$sdmode}{$profile}{$hat}{path}{$path};

2010

}

2011

$prelog{$sdmode}{$profile}{$hat}{path}{$path} = $mode;

2012

2013

# print "$pid $profile $hat $prog $sdmode $mode $path\n";

2014

}

2015

2016

if ($do_execute) {

2017

next if ( profile_known_exec($sd{$profile}{$hat},

2018

"exec", $exec_target ) );

2019

2020

my $p = update_repo_profile($sd{$profile}{$profile});

2021

2022

if ($to_name) {

2023

next if ( $to_name and

2024

UI_SelectUpdatedRepoProfile($profile, $p) and

2025

profile_known_exec($sd{$profile}{$hat},

2026

"exec", $to_name ) );

2027

} else {

2028

next if ( UI_SelectUpdatedRepoProfile($profile, $p) and

2029

profile_known_exec($sd{$profile}{$hat},

2030

"exec", $exec_target ) );

2031

}

2032

2033

my $context = $profile;

2034

$context .= "^$hat" if $profile ne $hat;

2035

$context .= " -> $exec_target";

2036

my $ans = $transitions{$context} || "";

2037

2038

my ($combinedmode, $combinedaudit, $cm, $am, @m);

2039

$combinedmode = 0;

2040

$combinedaudit = 0;

2041

2042

# does path match any regexps in original profile?

2043

($cm, $am, @m) = rematchfrag($sd{$profile}{$hat}, 'allow', $exec_target);

2044

$combinedmode |= $cm if $cm;

2045

$combinedaudit |= $am if $am;

2046

2047

# find the named transition if is present

2048

if ($combinedmode & str_to_mode("x")) {

2049

my $nt_name;

2050

foreach my $entry (@m) {

2051

if ($sd{$profile}{$hat}{allow}{path}{$entry}{to}) {

2052

$nt_name = $sd{$profile}{$hat}{allow}{path}{$entry}{to};

2053

last;

2054

}

2055

}

2056

if ($to_name and $nt_name and ($to_name ne $nt_name)) {

2057

#fatal_error "transition name from "

2058

} elsif ($nt_name) {

2059

$to_name = $nt_name;

2060

}

2061

}

2062

2063

# does path match anything pulled in by includes in

2064

# original profile?

2065

($cm, $am, @m) = match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $exec_target);

2066

$combinedmode |= $cm if $cm;

2067

$combinedaudit |= $am if $am;

2068

if ($combinedmode & str_to_mode("x")) {

2069

my $nt_name;

2070

foreach my $entry (@m) {

2071

if ($sd{$profile}{$hat}{allow}{path}{$entry}{to}) {

2072

$nt_name = $sd{$profile}{$hat}{allow}{path}{$entry}{to};

2073

last;

2074

}

2075

}

2076

if ($to_name and $nt_name and ($to_name ne $nt_name)) {

2077

#fatal_error "transition name from "

2078

} elsif ($nt_name) {

2079

$to_name = $nt_name;

2080

}

2081

}

2082

2083

2084

#nx does not exist in profiles. It does in log

2085

#files however. The log parsing routines will convert

2086

#it to its profile form.

2087

#nx is internally represented by cx/px/cix/pix + to_name

2088

my $exec_mode = 0;

2089

if (contains($combinedmode, "pix")) {

2090

if ($to_name) {

2091

$ans = "CMD_nix";

2092

} else {

2093

$ans = "CMD_pix";

2094

}

2095

$exec_mode = str_to_mode("pixr");

2096

} elsif (contains($combinedmode, "cix")) {

2097

if ($to_name) {

2098

$ans = "CMD_nix";

2099

} else {

2100

$ans = "CMD_cix";

2101

}

2102

$exec_mode = str_to_mode("cixr");

2103

} elsif (contains($combinedmode, "Pix")) {

2104

if ($to_name) {

2105

$ans = "CMD_nix_safe";

2106

} else {

2107

$ans = "CMD_pix_safe";

2108

}

2109

$exec_mode = str_to_mode("Pixr");

2110

} elsif (contains($combinedmode, "Cix")) {

2111

if ($to_name) {

2112

$ans = "CMD_nix_safe";

2113

} else {

2114

$ans = "CMD_cix_safe";

2115

}

2116

$exec_mode = str_to_mode("Cixr");

2117

} elsif (contains($combinedmode, "ix")) {

2118

$ans = "CMD_ix";

2119

$exec_mode = str_to_mode("ixr");

2120

} elsif (contains($combinedmode, "px")) {

2121

if ($to_name) {

2122

$ans = "CMD_nx";

2123

} else {

2124

$ans = "CMD_px";

2125

}

2126

$exec_mode = str_to_mode("px");

2127

} elsif (contains($combinedmode, "cx")) {

2128

if ($to_name) {

2129

$ans = "CMD_nx";

2130

} else {

2131

$ans = "CMD_cx";

2132

}

2133

$exec_mode = str_to_mode("cx");

2134

} elsif (contains($combinedmode, "ux")) {

2135

$ans = "CMD_ux";

2136

$exec_mode = str_to_mode("ux");

2137

} elsif (contains($combinedmode, "Px")) {

2138

if ($to_name) {

2139

$ans = "CMD_nx_safe";

2140

} else {

2141

$ans = "CMD_px_safe";

2142

}

2143

$exec_mode = str_to_mode("Px");

2144

} elsif (contains($combinedmode, "Cx")) {

2145

if ($to_name) {

2146

$ans = "CMD_nx_safe";

2147

} else {

2148

$ans = "CMD_cx_safe";

2149

}

2150

$exec_mode = str_to_mode("Cx");

2151

} elsif (contains($combinedmode, "Ux")) {

2152

$ans = "CMD_ux_safe";

2153

$exec_mode = str_to_mode("Ux");

2154

} else {

2155

my $options = $cfg->{qualifiers}{$exec_target} || "ipcnu";

2156

fatal_error "$entry has transition name but not transition mode" if $to_name;

2157

2158

# force "ix" as the only option when the profiled

2159

# program executes itself

2160

$options = "i" if $exec_target eq $profile;

2161

2162

# for now don't allow hats to cx

2163

$options =~ s/c// if $hat and $hat ne $profile;

2164

2165

# we always need deny...

2166

$options .= "d";

2167

2168

# figure out what our default option should be...

2169

my $default;

2170

if ($options =~ /p/

2171

&& -e getprofilefilename($exec_target))

2172

{

2173

$default = "CMD_px";

2174

} elsif ($options =~ /i/) {

2175

$default = "CMD_ix";

2176

} elsif ($options =~ /c/) {

2177

$default = "CMD_cx";

2178

} elsif ($options =~ /n/) {

2179

$default = "CMD_nx";

2180

} else {

2181

$default = "CMD_DENY";

2182

}

2183

2184

# ugh, this doesn't work if someone does an ix before

2185

# calling this particular child process. at least

2186

# it's only a hint instead of mandatory to get this

2187

# right.

2188

my $parent_uses_ld_xxx = check_for_LD_XXX($profile);

2189

2190

my $severity = $sevdb->rank($exec_target, "x");

2191

2192

# build up the prompt...

2193

my $q = {};

2194

$q->{headers} = [];

2195

push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);

2196

if ($prog && $prog ne "HINT") {

2197

push @{ $q->{headers} }, gettext("Program"), $prog;

2198

}

2199

# $to_name should NOT exist here other wise we know what

2200

# mode we are supposed to be transitioning to

2201

# which is handled above.

2202

push @{ $q->{headers} }, gettext("Execute"), $exec_target;

2203

push @{ $q->{headers} }, gettext("Severity"), $severity;

2204

2205

$q->{functions} = [];

2206

2207

my $prompt = "\n$context\n";

2208

my $exec_toggle = 0;

2209

2210

push @{ $q->{functions} }, build_x_functions($default, $options, $exec_toggle);

2211

2212

$options = join("|", split(//, $options));

2213

2214

$seenevents++;

2215

2216

while ($ans !~ m/^CMD_(ix|px|cx|nx|pix|cix|nix|px_safe|cx_safe|nx_safe|pix_safe|cix_safe|nix_safe|ux|ux_safe|EXEC_TOGGLE|DENY)$/) {

2217

$ans = UI_PromptUser($q);

2218

2219

if ($ans =~ /CMD_EXEC_IX_/) {

2220

$exec_toggle = !$exec_toggle;

2221

2222

$q->{functions} = [ ];

2223

push @{ $q->{functions} }, build_x_functions($default, $options, $exec_toggle);

2224

$ans = "";

2225

next;

2226

}

2227

if ($ans =~ /CMD_(nx|nix)/) {

2228

my $arg = $exec_target;

2229

2230

my $ynans = "n";

2231

if ($profile eq $hat) {

2232

$ynans = UI_YesNo("Are you specifying a transition to a local profile?", "n");

2233

}

2234

2235

if ($ynans eq "y") {

2236

if ($ans eq "CMD_nx") {

2237

$ans = "CMD_cx";

2238

} else {

2239

$ans = "CMD_cix";

2240

}

2241

} else {

2242

if ($ans eq "CMD_nx") {

2243

$ans = "CMD_px";

2244

} else {

2245

$ans = "CMD_pix";

2246

}

2247

}

2248

$to_name = UI_GetString(gettext("Enter profile name to transition to: "), $arg);

2249

}

2250

if ($ans =~ /CMD_ix/) {

2251

$exec_mode = str_to_mode("ix");

2252

} elsif ($ans =~ /CMD_(px|cx|nx|pix|cix|nix)/) {

2253

my $match = $1;

2254

$exec_mode = str_to_mode($match);

2255

my $px_default = "n";

2256

my $px_mesg = gettext("Should AppArmor sanitize the environment when\nswitching profiles?\n\nSanitizing the environment is more secure,\nbut some applications depend on the presence\nof LD_PRELOAD or LD_LIBRARY_PATH.");

2257

if ($parent_uses_ld_xxx) {

2258

$px_mesg = gettext("Should AppArmor sanitize the environment when\nswitching profiles?\n\nSanitizing the environment is more secure,\nbut this application appears to use LD_PRELOAD\nor LD_LIBRARY_PATH and clearing these could\ncause functionality problems.");

2259

}

2260

my $ynans = UI_YesNo($px_mesg, $px_default);

2261

$ans = "CMD_$match";

2262

if ($ynans eq "y") {

2263

$exec_mode &= ~($AA_EXEC_UNSAFE | ($AA_EXEC_UNSAFE << $AA_OTHER_SHIFT));

2264

}

2265

} elsif ($ans eq "CMD_ux") {

2266

$exec_mode = str_to_mode("ux");

2267

my $ynans = UI_YesNo(sprintf(gettext("Launching processes in an unconfined state is a very\ndangerous operation and can cause serious security holes.\n\nAre you absolutely certain you wish to remove all\nAppArmor protection when executing \%s?"), $exec_target), "n");

2268

if ($ynans eq "y") {

2269

my $ynans = UI_YesNo(gettext("Should AppArmor sanitize the environment when\nrunning this program unconfined?\n\nNot sanitizing the environment when unconfining\na program opens up significant security holes\nand should be avoided if at all possible."), "y");

2270

if ($ynans eq "y") {

2271

$exec_mode &= ~($AA_EXEC_UNSAFE | ($AA_EXEC_UNSAFE << $AA_OTHER_SHIFT));

2272

}

2273

} else {

2274

$ans = "INVALID";

2275

}

2276

}

2277

}

2278

$transitions{$context} = $ans;

2279

2280

if ($ans =~ /CMD_(ix|px|cx|nx|pix|cix|nix)/) {

2281

# if we're inheriting, things'll bitch unless we have r

2282

if ($exec_mode & str_to_mode("i")) {

2283

$exec_mode |= str_to_mode("r");

2284

}

2285

2286

} else {

2287

if ($ans eq "CMD_DENY") {

2288

$sd{$profile}{$hat}{deny}{path}{$exec_target}{mode} |= str_to_mode("x");

2289

2290

$sd{$profile}{$hat}{deny}{path}{$exec_target}{audit} |= 0;

2291

$changed{$profile} = 1;

2292

# skip all remaining events if they say to deny

2293

# the exec

2294

return if $domainchange eq "change";

2295

}

2296

2297

}

2298

2299

unless ($ans eq "CMD_DENY") {

2300

# ???? if its defined in the prelog we shouldn't have asked

2301

if (defined $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target}) {

2302

# $exec_mode = $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target};

2303

}

2304

2305

$prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target} |= $exec_mode;

2306

$log{PERMITTING}{$profile} = {};

2307

$sd{$profile}{$hat}{allow}{path}{$exec_target}{mode} |= $exec_mode;

2308

$sd{$profile}{$hat}{allow}{path}{$exec_target}{audit} |= 0;

2309

$sd{$profile}{$hat}{allow}{path}{$exec_target}{to} = $to_name if ($to_name);

2310

2311

# mark this profile as changed

2312

$changed{$profile} = 1;

2313

2314

if ($exec_mode & str_to_mode("i")) {

2315

if ($exec_target =~ /perl/) {

2316

$sd{$profile}{$hat}{include}{"abstractions/perl"} = 1;

2317

} elsif ($detail =~ m/\/bin\/(bash|sh)/) {

2318

$sd{$profile}{$hat}{include}{"abstractions/bash"} = 1;

2319

}

2320

my $hashbang = head($exec_target);

2321

if ($hashbang =~ /^#!\s*(\S+)/) {

2322

my $interpreter = get_full_path($1);

2323

$sd{$profile}{$hat}{path}->{$interpreter}{mode} |= str_to_mode("ix");

2324

$sd{$profile}{$hat}{path}->{$interpreter}{audit} |= 0;

2325

if ($interpreter =~ /perl/) {

2326

$sd{$profile}{$hat}{include}{"abstractions/perl"} = 1;

2327

} elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {

2328

$sd{$profile}{$hat}{include}{"abstractions/bash"} = 1;

2329

}

2330

}

2331

}

2332

}

2333

}

2334

2335

# print "$pid $profile $hat EXEC $exec_target $ans $exec_mode\n";

2336

2337

# update our tracking info based on what kind of change

2338

# this is...

2339

if ($ans eq "CMD_ix") {

2340

if ($hat) {

2341

$profilechanges{$pid} = $profile . "//" . $hat;

2342

} else {

2343

$profilechanges{$pid} = $profile;

2344

}

2345

} elsif ($ans =~ /^CMD_(px|nx|pix|nix)/) {

2346

$exec_target = $to_name if ($to_name);

2347

if ($sdmode eq "PERMITTING") {

2348

if ($domainchange eq "change") {

2349

$profile = $exec_target;

2350

$hat = $exec_target;

2351

$profilechanges{$pid} = $profile;

2352

}

2353

}

2354

# if they want to use px, make sure a profile

2355

# exists for the target.

2356

unless (-e getprofilefilename($exec_target)) {

2357

my $ynans = "y";

2358

if ($exec_mode & str_to_mode("i")) {

2359

$ynans = UI_YesNo(sprintf(gettext("A profile for %s does not exist. Create one?"), $exec_target), "n");

2360

}

2361

if ($ynans eq "y") {

2362

$helpers{$exec_target} = "enforce";

2363

if ($to_name) {

2364

autodep_base("", $exec_target);

2365

} else {

2366

autodep_base($exec_target, "");

2367

}

2368

reload_base($exec_target);

2369

}

2370

}

2371

} elsif ($ans =~ /^CMD_(cx|cix)/) {

2372

$exec_target = $to_name if ($to_name);

2373

if ($sdmode eq "PERMITTING") {

2374

if ($domainchange eq "change") {

2375

$profilechanges{$pid} = "${profile}//${exec_target}";

2376

# $profile = $exec_target;

2377

# $hat = $exec_target;

2378

}

2379

}

2380

2381

# if they want to use cx, make sure a profile

2382

# exists for the target.

2383

unless ($sd{$profile}{$exec_target}) {

2384

my $ynans = "y";

2385

if ($exec_mode & str_to_mode("i")) {

2386

$ynans = UI_YesNo(sprintf(gettext("A local profile for %s does not exist. Create one?"), $exec_target), "n");

2387

}

2388

if ($ynans eq "y") {

2389

$hat = $exec_target;

2390

# keep track of profile flags

2391

#$profile_data->{$profile}{$hat}{flags} = ;

2392

2393

# we have seen more than a declaration so clear it

2394

$sd{$profile}{$hat}{'declared'} = 0;

2395

$sd{$profile}{$hat}{profile} = 1;

2396

2397

# Otherwise sub-profiles end up getting

2398

# put in enforce mode with genprof

2399

$sd{$profile}{$hat}{flags} = $sd{$profile}{$profile}{flags} if $profile ne $hat;

2400

2401

$sd{$profile}{$hat}{flags} = 'complain';

2402

$sd{$profile}{$hat}{allow}{path} = { };

2403

$sd{$profile}{$hat}{allow}{netdomain} = { };

2404

my $file = $sd{$profile}{$profile}{filename};

2405

$filelist{$file}{profiles}{$profile}{$hat} = 1;

2406

2407

}

2408

}

2409

} elsif ($ans =~ /^CMD_ux/) {

2410

$profilechanges{$pid} = "unconfined";

2411

return if $domainchange eq "change";

2412

}

2413

}

2414

} elsif ( $type eq "netdomain" ) {

2415

my ($pid, $p, $h, $prog, $sdmode, $family, $sock_type, $protocol) =

2416

@entry;

2417

2418

if ( ($p !~ /null(-complain)*-profile/)

2419

&& ($h !~ /null(-complain)*-profile/))

2420

{

2421

$profile = $p;

2422

$hat = $h;

2423

}

2424

2425

next unless $profile && $hat;

2426

$prelog{$sdmode}

2427

{$profile}

2428

{$hat}

2429

{netdomain}

2430

{$family}

2431

{$sock_type} = 1 unless ( !$family || !$sock_type );

2432

2433

}

2434

}

2435

}

2436

}

2437

2438

sub add_to_tree ($$$@) {

2439

my ($pid, $parent, $type, @event) = @_;

2440

if ( $DEBUGGING ) {

2441

my $eventmsg = Data::Dumper->Dump([@event], [qw(*event)]);

2442

$eventmsg =~ s/\n/ /g;

2443

debug " add_to_tree: pid [$pid] type [$type] event [ $eventmsg ]";

2444

}

2445

2446

unless (exists $pid{$pid}) {

2447

my $profile = $event[0];

2448

my $hat = $event[1];

2449

if ($parent && exists $pid{$parent}) {

2450

# fork entry is missing fake one so that fork tracking will work

2451

$hat ||= "null-complain-profile";

2452

my $arrayref = [];

2453

push @{ $pid{$parent} }, $arrayref;

2454

$pid{$pid} = $arrayref;

2455

push @{$arrayref}, [ "fork", $pid, $profile, $hat ];

2456

} else {

2457

my $arrayref = [];

2458

push @log, $arrayref;

2459

$pid{$pid} = $arrayref;

2460

}

2461

}

2462

2463

push @{ $pid{$pid} }, [ $type, $pid, @event ];

2464

}

2465

2466

#

2467

# variables used in the logparsing routines

2468

#

2469

our $LOG;

2470

our $next_log_entry;

2471

our $logmark;

2472

our $seenmark;

2473

my $RE_LOG_v2_0_syslog = qr/SubDomain/;

2474

my $RE_LOG_v2_1_syslog = qr/kernel:\s+(\[[\d\.\s]+\]\s+)?(audit$[\d\.\:]+$:\s+)?type=150[1-6]/;

2475

my $RE_LOG_v2_6_syslog = qr/kernel:\s+(\[[\d\.\s]+\]\s+)?type=\d+\s+audit$[\d\.\:]+$:\s+apparmor=/;

2476

my $RE_LOG_v2_0_audit =

2477

qr/type=(APPARMOR|UNKNOWN\[1500\]) msg=audit$[\d\.\:]+$:/;

2478

my $RE_LOG_v2_1_audit =

2479

2480

my $RE_LOG_v2_6_audit =

2481

qr/type=AVC\s+(msg=)?audit$[\d\.\:]+$:\s+apparmor=/;

2482

2483

sub prefetch_next_log_entry() {

2484

# if we already have an existing cache entry, something's broken

2485

if ($next_log_entry) {

2486

print STDERR "Already had next log entry: $next_log_entry";

2487

}

2488

2489

# read log entries until we either hit the end or run into an

2490

# AA event message format we recognize

2491

do {

2492

$next_log_entry = <$LOG>;

2493

$DEBUGGING && debug "prefetch_next_log_entry: next_log_entry = " . ($next_log_entry ? $next_log_entry : "empty");

2494

} until (!$next_log_entry || $next_log_entry =~ m{

2495

$RE_LOG_v2_0_syslog |

2496

$RE_LOG_v2_0_audit |

2497

$RE_LOG_v2_1_audit |

2498

$RE_LOG_v2_1_syslog |

2499

$RE_LOG_v2_6_syslog |

2500

$RE_LOG_v2_6_audit |

2501

$logmark

2502

}x);

2503

}

2504

2505

sub get_next_log_entry() {

2506

# make sure we've got a next log entry if there is one

2507

prefetch_next_log_entry() unless $next_log_entry;

2508

2509

# save a copy of the next log entry...

2510

my $log_entry = $next_log_entry;

2511

2512

# zero out our cache of the next log entry

2513

$next_log_entry = undef;

2514

2515

return $log_entry;

2516

}

2517

2518

sub peek_at_next_log_entry() {

2519

# make sure we've got a next log entry if there is one

2520

prefetch_next_log_entry() unless $next_log_entry;

2521

2522

# return a copy of the next log entry without pulling it out of the cache

2523

return $next_log_entry;

2524

}

2525

2526

sub throw_away_next_log_entry() {

2527

$next_log_entry = undef;

2528

}

2529

2530

sub parse_log_record_v_2_0 ($$) {

2531

my ($record, $last) = @_;

2532

$DEBUGGING && debug "parse_log_record_v_2_0: $record";

2533

2534

# What's this early out for? As far as I can tell, parse_log_record_v_2_0

2535

# won't ever be called without something in $record

2536

return $last if ( ! $record );

2537

2538

$_ = $record;

2539

2540

if (s/(PERMITTING|REJECTING)-SYSLOGFIX/$1/) {

2541

s/%%/%/g;

2542

}

2543

2544

if (m/LOGPROF-HINT unknown_hat (\S+) pid=(\d+) profile=(.+) active=(.+)/) {

2545

my ($uhat, $pid, $profile, $hat) = ($1, $2, $3, $4);

2546

2547

$last = $&;

2548

2549

# we want to ignore entries for profiles that don't exist

2550

# they're most likely broken entries or old entries for

2551

# deleted profiles

2552

return $&

2553

if ( ($profile ne 'null-complain-profile')

2554

&& (!profile_exists($profile)));

2555

2556

add_to_tree($pid, 0, "unknown_hat", $profile, $hat,

2557

"PERMITTING", $uhat);

2558

} elsif (m/LOGPROF-HINT (unknown_profile|missing_mandatory_profile) image=(.+) pid=(\d+) profile=(.+) active=(.+)/) {

2559

my ($image, $pid, $profile, $hat) = ($2, $3, $4, $5);

2560

2561

return $& if $last =~ /PERMITTING x access to $image/;

2562

$last = $&;

2563

2564

# we want to ignore entries for profiles that don't exist

2565

# they're most likely broken entries or old entries for

2566

# deleted profiles

2567

return $&

2568

if ( ($profile ne 'null-complain-profile')

2569

&& (!profile_exists($profile)));

2570

2571

add_to_tree($pid, 0, "exec", $profile, $hat, "HINT", "PERMITTING", "x", $image);

2572

2573

} elsif (m/(PERMITTING|REJECTING) (\S+) access (.+) $(.+)\((\d+)$ profile (.+) active (.+)\)/) {

2574

my ($sdmode, $mode, $detail, $prog, $pid, $profile, $hat) =

2575

($1, $2, $3, $4, $5, $6, $7);

2576

2577

if ($mode eq "link") {

2578

$mode = "l";

2579

}

2580

if (!validate_log_mode($mode)) {

2581

fatal_error(sprintf(gettext('Log contains unknown mode %s.'), $mode));

2582

}

2583

2584

my $domainchange = "nochange";

2585

if ($mode =~ /x/) {

2586

2587

# we need to try to check if we're doing a domain transition

2588

if ($sdmode eq "PERMITTING") {

2589

my $following = peek_at_next_log_entry();

2590

2591

if ($following && ($following =~ m/changing_profile/)) {

2592

$domainchange = "change";

2593

throw_away_next_log_entry();

2594

}

2595

}

2596

} else {

2597

2598

# we want to ignore duplicates for things other than executes...

2599

return $& if $seen{$&};

2600

$seen{$&} = 1;

2601

}

2602

2603

$last = $&;

2604

2605

# we want to ignore entries for profiles that don't exist

2606

# they're most likely broken entries or old entries for

2607

# deleted profiles

2608

if (($profile ne 'null-complain-profile')

2609

&& (!profile_exists($profile)))

2610

{

2611

return $&;

2612

}

2613

2614

# currently no way to stick pipe mediation in a profile, ignore

2615

# any messages like this

2616

return $& if $detail =~ /to pipe:/;

2617

2618

# strip out extra extended attribute info since we don't

2619

# currently have a way to specify it in the profile and

2620

# instead just need to provide the access to the base filename

2621

$detail =~ s/\s+extended attribute \S+//;

2622

2623

# kerberos code checks to see if the krb5.conf file is world

2624

# writable in a stupid way so we'll ignore any w accesses to

2625

# krb5.conf

2626

return $& if (($detail eq "to /etc/krb5.conf") && contains($mode, "w"));

2627

2628

# strip off the (deleted) tag that gets added if it's a

2629

# deleted file

2630

$detail =~ s/\s+$deleted$$//;

2631

2632

# next if (($detail =~ /to \/lib\/ld-/) && ($mode =~ /x/));

2633

2634

$detail =~ s/^to\s+//;

2635

2636

if ($domainchange eq "change") {

2637

add_to_tree($pid, 0, "exec", $profile, $hat, $prog,

2638

$sdmode, str_to_mode($mode), $detail);

2639

} else {

2640

add_to_tree($pid, 0, "path", $profile, $hat, $prog,

2641

$sdmode, str_to_mode($mode), $detail);

2642

}

2643

2644

} elsif (m/(PERMITTING|REJECTING) (?:mk|rm)dir on (.+) $(.+)\((\d+)$ profile (.+) active (.+)\)/) {

2645

my ($sdmode, $path, $prog, $pid, $profile, $hat) =

2646

($1, $2, $3, $4, $5, $6);

2647

2648

# we want to ignore duplicates for things other than executes...

2649

return $& if $seen{$&}++;

2650

2651

$last = $&;

2652

2653

# we want to ignore entries for profiles that don't exist

2654

# they're most likely broken entries or old entries for

2655

# deleted profiles

2656

return $&

2657

if ( ($profile ne 'null-complain-profile')

2658

&& (!profile_exists($profile)));

2659

2660

add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,

2661

"w", $path);

2662

2663

} elsif (m/(PERMITTING|REJECTING) xattr (\S+) on (.+) $(.+)\((\d+)$ profile (.+) active (.+)\)/) {

2664

my ($sdmode, $xattr_op, $path, $prog, $pid, $profile, $hat) =

2665

($1, $2, $3, $4, $5, $6, $7);

2666

2667

# we want to ignore duplicates for things other than executes...

2668

return $& if $seen{$&}++;

2669

2670

$last = $&;

2671

2672

# we want to ignore entries for profiles that don't exist

2673

# they're most likely broken entries or old entries for

2674

# deleted profiles

2675

return $&

2676

if ( ($profile ne 'null-complain-profile')

2677

&& (!profile_exists($profile)));

2678

2679

my $xattrmode;

2680

if ($xattr_op eq "get" || $xattr_op eq "list") {

2681

$xattrmode = "r";

2682

} elsif ($xattr_op eq "set" || $xattr_op eq "remove") {

2683

$xattrmode = "w";

2684

}

2685

2686

if ($xattrmode) {

2687

add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,

2688

str_to_mode($xattrmode), $path);

2689

}

2690

2691

} elsif (m/(PERMITTING|REJECTING) attribute $(.*?)$ change to (.+) $(.+)\((\d+)$ profile (.+) active (.+)\)/) {

2692

my ($sdmode, $change, $path, $prog, $pid, $profile, $hat) =

2693

($1, $2, $3, $4, $5, $6, $7);

2694

2695

# we want to ignore duplicates for things other than executes...

2696

return $& if $seen{$&};

2697

$seen{$&} = 1;

2698

2699

$last = $&;

2700

2701

# we want to ignore entries for profiles that don't exist

2702

# they're most likely broken entries or old entries for

2703

# deleted profiles

2704

return $&

2705

if ( ($profile ne 'null-complain-profile')

2706

&& (!profile_exists($profile)));

2707

2708

# kerberos code checks to see if the krb5.conf file is world

2709

# writable in a stupid way so we'll ignore any w accesses to

2710

# krb5.conf

2711

return $& if $path eq "/etc/krb5.conf";

2712

2713

add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,

2714

str_to_mode("w"), $path);

2715

2716

} elsif (m/(PERMITTING|REJECTING) access to capability '(\S+)' $(.+)\((\d+)$ profile (.+) active (.+)\)/) {

2717

my ($sdmode, $capability, $prog, $pid, $profile, $hat) =

2718

($1, $2, $3, $4, $5, $6);

2719

2720

return $& if $seen{$&};

2721

2722

$seen{$&} = 1;

2723

$last = $&;

2724

2725

# we want to ignore entries for profiles that don't exist - they're

2726

# most likely broken entries or old entries for deleted profiles

2727

return $&

2728

if ( ($profile ne 'null-complain-profile')

2729

&& (!profile_exists($profile)));

2730

2731

add_to_tree($pid, 0, "capability", $profile, $hat, $prog,

2732

$sdmode, $capability);

2733

2734

} elsif (m/Fork parent (\d+) child (\d+) profile (.+) active (.+)/

2735

|| m/LOGPROF-HINT fork pid=(\d+) child=(\d+) profile=(.+) active=(.+)/

2736

|| m/LOGPROF-HINT fork pid=(\d+) child=(\d+)/)

2737

{

2738

my ($parent, $child, $profile, $hat) = ($1, $2, $3, $4);

2739

2740

$profile ||= "null-complain-profile";

2741

$hat ||= "null-complain-profile";

2742

2743

$last = $&;

2744

2745

# we want to ignore entries for profiles that don't exist

2746

# they're most likely broken entries or old entries for

2747

# deleted profiles

2748

return $&

2749

if ( ($profile ne 'null-complain-profile')

2750

&& (!profile_exists($profile)));

2751

2752

my $arrayref = [];

2753

if (exists $pid{$parent}) {

2754

push @{ $pid{$parent} }, $arrayref;

2755

} else {

2756

push @log, $arrayref;

2757

}

2758

$pid{$child} = $arrayref;

2759

push @{$arrayref}, [ "fork", $child, $profile, $hat ];

2760

} else {

2761

$DEBUGGING && debug "UNHANDLED: $_";

2762

}

2763

return $last;

2764

}

2765

2766

sub parse_log_record ($) {

2767

my $record = shift;

2768

$DEBUGGING && debug "parse_log_record: $record";

2769

my $e = parse_event($record);

2770

2771

return $e;

2772

}

2773

2774

2775

sub add_event_to_tree ($) {

2776

my $e = shift;

2777

2778

my $sdmode = $e->{sdmode}?$e->{sdmode}:"UNKNOWN";

2779

if ( $e->{type} ) {

2780

if ( $e->{type} =~ /(UNKNOWN\[1501\]|APPARMOR_AUDIT|1501)/ ) {

2781

$sdmode = "AUDIT";

2782

} elsif ( $e->{type} =~ /(UNKNOWN\[1502\]|APPARMOR_ALLOWED|1502)/ ) {

2783

$sdmode = "PERMITTING";

2784

} elsif ( $e->{type} =~ /(UNKNOWN\[1503\]|APPARMOR_DENIED|1503)/ ) {

2785

$sdmode = "REJECTING";

2786

} elsif ( $e->{type} =~ /(UNKNOWN\[1504\]|APPARMOR_HINT|1504)/ ) {

2787

$sdmode = "HINT";

2788

} elsif ( $e->{type} =~ /(UNKNOWN\[1505\]|APPARMOR_STATUS|1505)/ ) {

2789

$sdmode = "STATUS";

2790

} elsif ( $e->{type} =~ /(UNKNOWN\[1506\]|APPARMOR_ERROR|1506)/ ) {

2791

$sdmode = "ERROR";

2792

} else {

2793

$sdmode = "UNKNOWN";

2794

}

2795

}

2796

return if ( $sdmode =~ /UNKNOWN|AUDIT|STATUS|ERROR/ );

2797

return if ($e->{operation} =~ /profile_set/);

2798

2799

my ($profile, $hat);

2800

2801

# The version of AppArmor that was accepted into the mainline kernel

2802

# issues audit events for things like change_hat while unconfined.

2803

# Previous versions just returned -EPERM without the audit so the

2804

# events wouldn't have been picked up here.

2805

return if (!$e->{profile});

2806

2807

# just convert new null profile style names to old before we begin processing

2808

# profile and name can contain multiple layers of null- but all we care about

2809

# currently is single level.

2810

if ($e->{profile} =~ m/\/\/null-/) {

2811

$e->{profile} = "null-complain-profile";

2812

}

2813

($profile, $hat) = split /\/\//, $e->{profile};

2814

if ( $e->{operation} eq "change_hat" ) {

2815

#screen out change_hat events that aren't part of learning, as before

2816

#AppArmor 2.4 these events only happend as hints during learning

2817

return if ($sdmode ne "HINT" && $sdmode ne "PERMITTING");

2818

($profile, $hat) = split /\/\//, $e->{name};

2819

}

2820

$hat = $profile if ( !$hat );

2821

# TODO - refactor add_to_tree as prog is no longer supplied

2822

# HINT is from previous format where prog was not

2823

# consistently passed

2824

my $prog = "HINT";

2825

2826

return if ($profile ne 'null-complain-profile' && !profile_exists($profile));

2827

2828

if ($e->{operation} eq "exec") {

2829

if ( defined $e->{info} && $e->{info} eq "mandatory profile missing" ) {

2830

add_to_tree( $e->{pid},

2831

$e->{parent},

2832

"exec",

2833

$profile,

2834

$hat,

2835

$sdmode,

2836

"PERMITTING",

2837

$e->{denied_mask},

2838

$e->{name},

2839

$e->{name2}

2840

);

2841

} elsif ( defined $e->{name2} && $e->{name2} =~ m/\/\/null-/) {

2842

add_to_tree( $e->{pid},

2843

$e->{parent},

2844

"exec",

2845

$profile,

2846

$hat,

2847

$prog,

2848

$sdmode,

2849

$e->{denied_mask},

2850

$e->{name},

2851

""

2852

);

2853

}

2854

} elsif ($e->{operation} =~ m/file_/) {

2855

add_to_tree( $e->{pid},

2856

$e->{parent},

2857

"path",

2858

$profile,

2859

$hat,

2860

$prog,

2861

$sdmode,

2862

$e->{denied_mask},

2863

$e->{name},

2864

"",

2865

);

2866

} elsif ($e->{operation} eq "open" ||

2867

$e->{operation} eq "truncate" ||

2868

$e->{operation} eq "mkdir" ||

2869

$e->{operation} eq "mknod" ||

2870

$e->{operation} eq "rename_src" ||

2871

$e->{operation} eq "rename_dest" ||

2872

$e->{operation} =~ m/^(unlink|rmdir|symlink_create|link)$/) {

2873

add_to_tree( $e->{pid},

2874

$e->{parent},

2875

"path",

2876

$profile,

2877

$hat,

2878

$prog,

2879

$sdmode,

2880

$e->{denied_mask},

2881

$e->{name},

2882

"",

2883

);

2884

} elsif ($e->{operation} eq "capable") {

2885

add_to_tree( $e->{pid},

2886

$e->{parent},

2887

"capability",

2888

$profile,

2889

$hat,

2890

$prog,

2891

$sdmode,

2892

$e->{name}

2893

);

2894

} elsif ($e->{operation} =~ m/xattr/ ||

2895

$e->{operation} eq "setattr") {

2896

add_to_tree( $e->{pid},

2897

$e->{parent},

2898

"path",

2899

$profile,

2900

$hat,

2901

$prog,

2902

$sdmode,

2903

$e->{denied_mask},

2904

$e->{name},

2905

""

2906

);

2907

} elsif ($e->{operation} =~ m/inode_/) {

2908

my $is_domain_change = 0;

2909

2910

if ($e->{operation} eq "inode_permission" &&

2911

$e->{denied_mask} & $AA_MAY_EXEC &&

2912

$sdmode eq "PERMITTING") {

2913

2914

my $following = peek_at_next_log_entry();

2915

if ($following) {

2916

my $entry = parse_log_record($following);

2917

if ($entry &&

2918

$entry->{info} &&

2919

$entry->{info} eq "set profile" ) {

2920

2921

$is_domain_change = 1;

2922

throw_away_next_log_entry();

2923

}

2924

}

2925

}

2926

2927

if ($is_domain_change) {

2928

add_to_tree( $e->{pid},

2929

$e->{parent},

2930

"exec",

2931

$profile,

2932

$hat,

2933

$prog,

2934

$sdmode,

2935

$e->{denied_mask},

2936

$e->{name},

2937

$e->{name2}

2938

);

2939

} else {

2940

add_to_tree( $e->{pid},

2941

$e->{parent},

2942

"path",

2943

$profile,

2944

$hat,

2945

$prog,

2946

$sdmode,

2947

$e->{denied_mask},

2948

$e->{name},

2949

""

2950

);

2951

}

2952

} elsif ($e->{operation} eq "sysctl") {

2953

add_to_tree( $e->{pid},

2954

$e->{parent},

2955

"path",

2956

$profile,

2957

$hat,

2958

$prog,

2959

$sdmode,

2960

$e->{denied_mask},

2961

$e->{name},

2962

""

2963

);

2964

} elsif ($e->{operation} eq "clone") {

2965

my ($parent, $child) = ($e->{pid}, $e->{task});

2966

$profile ||= "null-complain-profile";

2967

$hat ||= "null-complain-profile";

2968

my $arrayref = [];

2969

if (exists $pid{$parent}) {

2970

push @{ $pid{$parent} }, $arrayref;

2971

} else {

2972

push @log, $arrayref;

2973

}

2974

$pid{$child} = $arrayref;

2975

push @{$arrayref}, [ "fork", $child, $profile, $hat ];

2976

} elsif (optype($e->{operation}) eq "net") {

2977

add_to_tree( $e->{pid},

2978

$e->{parent},

2979

"netdomain",

2980

$profile,

2981

$hat,

2982

$prog,

2983

$sdmode,

2984

$e->{family},

2985

$e->{sock_type},

2986

$e->{protocol},

2987

);

2988

} elsif ($e->{operation} eq "change_hat") {

2989

add_to_tree($e->{pid}, $e->{parent}, "unknown_hat", $profile, $hat, $sdmode, $hat);

2990

} else {

2991

if ( $DEBUGGING ) {

2992

my $msg = Data::Dumper->Dump([$e], [qw(*event)]);

2993

debug "UNHANDLED: $msg";

2994

}

2995

}

2996

}

2997

2998

sub read_log($) {

2999

$logmark = shift;

3000

$seenmark = $logmark ? 0 : 1;

3001

my $last;

3002

my $event_type;

3003

3004

# okay, done loading the previous profiles, get on to the good stuff...

3005

open($LOG, $filename)

3006

or fatal_error "Can't read AppArmor logfile $filename: $!";

3007

while ($_ = get_next_log_entry()) {

3008

chomp;

3009

3010

$DEBUGGING && debug "read_log: $_";

3011

3012

$seenmark = 1 if /$logmark/;

3013

3014

$DEBUGGING && debug "read_log: seenmark = $seenmark";

3015

next unless $seenmark;

3016

3017

my $last_match = ""; # v_2_0 syslog record parsing requires

3018

# the previous aa record in the mandatory profile

3019

# case

3020

# all we care about is apparmor messages

3021

if (/$RE_LOG_v2_0_syslog/ || /$RE_LOG_v2_0_audit/) {

3022

$last_match = parse_log_record_v_2_0( $_, $last_match );

3023

} else {

3024

my $event = parse_log_record($_);

3025

add_event_to_tree($event) if ( $event );

3026

}

3027

}

3028

close($LOG);

3029

$logmark = "";

3030

}

3031

3032

3033

sub UI_SelectUpdatedRepoProfile ($$) {

3034

3035

my ($profile, $p) = @_;

3036

my $distro = $cfg->{repository}{distro};

3037

my $url = $sd{$profile}{$profile}{repo}{url};

3038

my $user = $sd{$profile}{$profile}{repo}{user};

3039

my $id = $sd{$profile}{$profile}{repo}{id};

3040

my $updated = 0;

3041

3042

if ($p) {

3043

my $q = { };

3044

$q->{headers} = [

3045

"Profile", $profile,

3046

"User", $user,

3047

"Old Revision", $id,

3048

"New Revision", $p->{id},

3049

];

3050

$q->{explanation} =

3051

gettext( "An updated version of this profile has been found in the profile repository. Would you like to use it?");

3052

$q->{functions} = [

3053

"CMD_VIEW_CHANGES", "CMD_UPDATE_PROFILE", "CMD_IGNORE_UPDATE",

3054

"CMD_ABORT", "CMD_FINISHED"

3055

];

3056

3057

my $ans;

3058

do {

3059

$ans = UI_PromptUser($q);

3060

3061

if ($ans eq "CMD_VIEW_CHANGES") {

3062

my $oldprofile = serialize_profile($sd{$profile}, $profile);

3063

my $newprofile = $p->{profile};

3064

display_changes($oldprofile, $newprofile);

3065

}

3066

} until $ans =~ /^CMD_(UPDATE_PROFILE|IGNORE_UPDATE)/;

3067

3068

if ($ans eq "CMD_UPDATE_PROFILE") {

3069

eval {

3070

my $profile_data =

3071

parse_profile_data($p->{profile}, getprofilefilename($profile), 0);

3072

if ($profile_data) {

3073

attach_profile_data(\%sd, $profile_data);

3074

$changed{$profile} = 1;

3075

}

3076

3077

set_repo_info($sd{$profile}{$profile}, $url, $user, $p->{id});

3078

3079

UI_Info(

3080

sprintf(

3081

gettext("Updated profile %s to revision %s."),

3082

$profile, $p->{id}

3083

)

3084

);

3085

};

3086

3087

if ($@) {

3088

UI_Info(gettext("Error parsing repository profile."));

3089

} else {

3090

$updated = 1;

3091

}

3092

}

3093

}

3094

return $updated;

3095

}

3096

3097

sub UI_repo_signup() {

3098

3099

my ($url, $res, $save_config, $newuser, $user, $pass, $email, $signup_okay);

3100

$url = $cfg->{repository}{url};

3101

do {

3102

if ($UI_Mode eq "yast") {

3103

SendDataToYast(

3104

{

3105

type => "dialog-repo-sign-in",

3106

repo_url => $url

3107

}

3108

);

3109

my ($ypath, $yarg) = GetDataFromYast();

3110

$email = $yarg->{email};

3111

$user = $yarg->{user};

3112

$pass = $yarg->{pass};

3113

$newuser = $yarg->{newuser};

3114

$save_config = $yarg->{save_config};

3115

if ($yarg->{cancelled} && $yarg->{cancelled} eq "y") {

3116

return;

3117

}

3118

$DEBUGGING && debug("AppArmor Repository: \n\t " .

3119

($newuser eq "1") ?

3120

"New User\n\temail: [" . $email . "]" :

3121

"Signin" . "\n\t user[" . $user . "]" .

3122

"password [" . $pass . "]\n");

3123

} else {

3124

$newuser = UI_YesNo(gettext("Create New User?"), "n");

3125

$user = UI_GetString(gettext("Username: "), $user);

3126

$pass = UI_GetString(gettext("Password: "), $pass);

3127

$email = UI_GetString(gettext("Email Addr: "), $email)

3128

if ($newuser eq "y");

3129

$save_config = UI_YesNo(gettext("Save Configuration? "), "y");

3130

}

3131

3132

if ($newuser eq "y") {

3133

my ($status_ok,$res) = user_register($url, $user, $pass, $email);

3134

if ($status_ok) {

3135

$signup_okay = 1;

3136

} else {

3137

my $errmsg =

3138

gettext("The Profile Repository server returned the following error:") .

3139

"\n" . $res?$res:gettext("UNKOWN ERROR") . "\n" .

3140

gettext("Please re-enter registration information or contact the administrator.");

3141

UI_Important(gettext("Login Error\n") . $errmsg);

3142

}

3143

} else {

3144

my ($status_ok,$res) = user_login($url, $user, $pass);

3145

if ($status_ok) {

3146

$signup_okay = 1;

3147

} else {

3148

my $errmsg = gettext("Login failure\n Please check username and password and try again.") . "\n" . $res;

3149

UI_Important($errmsg);

3150

}

3151

}

3152

} until $signup_okay;

3153

3154

$repo_cfg->{repository}{user} = $user;

3155

$repo_cfg->{repository}{pass} = $pass;

3156

$repo_cfg->{repository}{email} = $email;

3157

3158

write_config("repository.conf", $repo_cfg) if ( $save_config eq "y" );

3159

3160

return ($user, $pass);

3161

}

3162

3163

sub UI_ask_to_enable_repo() {

3164

3165

my $q = { };

3166

return if ( not defined $cfg->{repository}{url} );

3167

$q->{headers} = [

3168

gettext("Repository"), $cfg->{repository}{url},

3169

];

3170

$q->{explanation} = gettext( "Would you like to enable access to the

3171

profile repository?" ); $q->{functions} = [ "CMD_ENABLE_REPO",

3172

"CMD_DISABLE_REPO", "CMD_ASK_LATER", ];

3173

3174

my $cmd;

3175

do {

3176

$cmd = UI_PromptUser($q);

3177

} until $cmd =~ /^CMD_(ENABLE_REPO|DISABLE_REPO|ASK_LATER)/;

3178

3179

if ($cmd eq "CMD_ENABLE_REPO") {

3180

$repo_cfg->{repository}{enabled} = "yes";

3181

} elsif ($cmd eq "CMD_DISABLE_REPO") {

3182

$repo_cfg->{repository}{enabled} = "no";

3183

} elsif ($cmd eq "CMD_ASK_LATER") {

3184

$repo_cfg->{repository}{enabled} = "later";

3185

}

3186

3187

eval { write_config("repository.conf", $repo_cfg) };

3188

if ($@) {

3189

fatal_error($@);

3190

}

3191

}

3192

3193

3194

sub UI_ask_to_upload_profiles() {

3195

3196

my $q = { };

3197

$q->{headers} = [

3198

gettext("Repository"), $cfg->{repository}{url},

3199

];

3200

$q->{explanation} =

3201

gettext( "Would you like to upload newly created and changed profiles to

3202

the profile repository?" );

3203

$q->{functions} = [

3204

"CMD_YES", "CMD_NO", "CMD_ASK_LATER",

3205

];

3206

3207

my $cmd;

3208

do {

3209

$cmd = UI_PromptUser($q);

3210

} until $cmd =~ /^CMD_(YES|NO|ASK_LATER)/;

3211

3212

if ($cmd eq "CMD_NO") {

3213

$repo_cfg->{repository}{upload} = "no";

3214

} elsif ($cmd eq "CMD_YES") {

3215

$repo_cfg->{repository}{upload} = "yes";

3216

} elsif ($cmd eq "CMD_ASK_LATER") {

3217

$repo_cfg->{repository}{upload} = "later";

3218

}

3219

3220

eval { write_config("repository.conf", $repo_cfg) };

3221

if ($@) {

3222

fatal_error($@);

3223

}

3224

}

3225

3226

3227

sub parse_repo_profile($$$) {

3228

my ($fqdbin, $repo_url, $profile) = @_;

3229

3230

my $profile_data = eval {

3231

parse_profile_data($profile->{profile}, getprofilefilename($fqdbin), 0);

3232

};

3233

if ($@) {

3234

print STDERR "PARSING ERROR: $@\n";

3235

$profile_data = undef;

3236

}

3237

3238

if ($profile_data) {

3239

set_repo_info($profile_data->{$fqdbin}{$fqdbin}, $repo_url,

3240

$profile->{username}, $profile->{id});

3241

}

3242

3243

return $profile_data;

3244

}

3245

3246

3247

sub set_repo_info($$$$) {

3248

my ($profile_data, $repo_url, $username, $id) = @_;

3249

3250

# save repository metadata

3251

$profile_data->{repo}{url} = $repo_url;

3252

$profile_data->{repo}{user} = $username;

3253

$profile_data->{repo}{id} = $id;

3254

}

3255

3256

3257

sub is_repo_profile($) {

3258

my $profile_data = shift;

3259

3260

return $profile_data->{repo}{url} &&

3261

$profile_data->{repo}{user} &&

3262

$profile_data->{repo}{id};

3263

}

3264

3265

3266

sub get_repo_user_pass() {

3267

my ($user, $pass);

3268

3269

if ($repo_cfg) {

3270

$user = $repo_cfg->{repository}{user};

3271

$pass = $repo_cfg->{repository}{pass};

3272

}

3273

3274

unless ($user && $pass) {

3275

($user, $pass) = UI_repo_signup();

3276

}

3277

3278

return ($user, $pass);

3279

}

3280

3281

3282

sub get_preferred_user ($) {

3283

my $repo_url = shift;

3284

return $cfg->{repository}{preferred_user} || "NOVELL";

3285

}

3286

3287

3288

sub repo_is_enabled () {

3289

my $enabled;

3290

if ($cfg->{repository}{url} &&

3291

$repo_cfg &&

3292

$repo_cfg->{repository}{enabled} &&

3293

$repo_cfg->{repository}{enabled} eq "yes") {

3294

$enabled = 1;

3295

}

3296

return $enabled;

3297

}

3298

3299

3300

sub update_repo_profile($) {

3301

my $profile = shift;

3302

3303

return undef if ( not is_repo_profile($profile) );

3304

my $distro = $cfg->{repository}{distro};

3305

my $url = $profile->{repo}{url};

3306

my $user = $profile->{repo}{user};

3307

my $id = $profile->{repo}{id};

3308

3309

UI_BusyStart( gettext("Connecting to repository.....") );

3310

my ($status_ok,$res) = fetch_newer_profile( $url,

3311

$distro,

3312

$user,

3313

$id,

3314

$profile->{name}

3315

);

3316

UI_BusyStop();

3317

if ( ! $status_ok ) {

3318

my $errmsg =

3319

sprintf(

3320

gettext("WARNING: Profile update check failed\nError Detail:\n%s"),

3321

defined $res?$res:gettext("UNKNOWN ERROR"));

3322

UI_Important($errmsg);

3323

$res = undef;

3324

}

3325

return( $res );

3326

}

3327

3328

sub UI_ask_mode_toggles ($$$) {

3329

my ($audit_toggle, $owner_toggle, $oldmode) = @_;

3330

my $q = { };

3331

$q->{headers} = [ ];

3332

# "Repository", $cfg->{repository}{url},

3333

# ];

3334

$q->{explanation} = gettext( "Change mode modifiers");

3335

3336

if ($audit_toggle) {

3337

$q->{functions} = [ "CMD_AUDIT_OFF" ];

3338

} else {

3339

$q->{functions} = [ "CMD_AUDIT_NEW" ];

3340

push @{$q->{functions}}, "CMD_AUDIT_FULL" if ($oldmode);

3341

}

3342

3343

if ($owner_toggle) {

3344

push @{$q->{functions}}, "CMD_USER_OFF";

3345

} else {

3346

push @{$q->{functions}}, "CMD_USER_ON";

3347

}

3348

push @{$q->{functions}}, "CMD_CONTINUE";

3349

3350

my $cmd;

3351

do {

3352

$cmd = UI_PromptUser($q);

3353

} until $cmd =~ /^CMD_(AUDIT_OFF|AUDIT_NEW|AUDIT_FULL|USER_ON|USER_OFF|CONTINUE)/;

3354

3355

if ($cmd eq "CMD_AUDIT_OFF") {

3356

$audit_toggle = 0;

3357

} elsif ($cmd eq "CMD_AUDIT_NEW") {

3358

$audit_toggle = 1;

3359

} elsif ($cmd eq "CMD_AUDIT_FULL") {

3360

$audit_toggle = 2;

3361

} elsif ($cmd eq "CMD_USER_ON") {

3362

$owner_toggle = 1;

3363

} elsif ($cmd eq "CMD_USER_OFF") {

3364

$owner_toggle = 0;

3365

# $owner_toggle++;

3366

# $owner_toggle++ if (!$oldmode && $owner_toggle == 2);

3367

# $owner_toggle = 0 if ($owner_toggle > 3);

3368

}

3369

return ($audit_toggle, $owner_toggle);

3370

}

3371

3372

sub ask_the_questions() {

3373

my $found; # do the magic foo-foo

3374

for my $sdmode (sort keys %log) {

3375

3376

# let them know what sort of changes we're about to list...

3377

if ($sdmode eq "PERMITTING") {

3378

UI_Info(gettext("Complain-mode changes:"));

3379

} elsif ($sdmode eq "REJECTING") {

3380

UI_Info(gettext("Enforce-mode changes:"));

3381

} else {

3382

3383

# if we're not permitting and not rejecting, something's broken.

3384

# most likely the code we're using to build the hash tree of log

3385

# entries - this should never ever happen

3386

fatal_error(sprintf(gettext('Invalid mode found: %s'), $sdmode));

3387

}

3388

3389

for my $profile (sort keys %{ $log{$sdmode} }) {

3390

my $p = update_repo_profile($sd{$profile}{$profile});

3391

UI_SelectUpdatedRepoProfile($profile, $p) if ( $p );

3392

3393

$found++;

3394

3395

# this sorts the list of hats, but makes sure that the containing

3396

# profile shows up in the list first to keep the question order

3397

# rational

3398

my @hats =

3399

grep { $_ ne $profile } keys %{ $log{$sdmode}{$profile} };

3400

unshift @hats, $profile

3401

if defined $log{$sdmode}{$profile}{$profile};

3402

3403

for my $hat (@hats) {

3404

3405

# step through all the capabilities first...

3406

for my $capability (sort keys %{ $log{$sdmode}{$profile}{$hat}{capability} }) {

3407

3408

# we don't care about it if we've already added it to the

3409

# profile

3410

next if profile_known_capability($sd{$profile}{$hat},

3411

$capability);

3412

3413

my $severity = $sevdb->rank(uc("cap_$capability"));

3414

3415

my $defaultoption = 1;

3416

my @options = ();

3417

my @newincludes;

3418

@newincludes = matchcapincludes($sd{$profile}{$hat},

3419

$capability);

3420

3421

3422

my $q = {};

3423

3424

if (@newincludes) {

3425

push @options,

3426

map { "#include <$_>" } sort(uniq(@newincludes));

3427

}

3428

3429

if ( @options ) {

3430

push @options, "capability $capability";

3431

$q->{options} = [@options];

3432

$q->{selected} = $defaultoption - 1;

3433

}

3434

3435

$q->{headers} = [];

3436

push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);

3437

push @{ $q->{headers} }, gettext("Capability"), $capability;

3438

push @{ $q->{headers} }, gettext("Severity"), $severity;

3439

3440

my $audit_toggle = 0;

3441

$q->{functions} = [

3442

"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_NEW", "CMD_ABORT", "CMD_FINISHED"

3443

];

3444

3445

# complain-mode events default to allow - enforce defaults

3446

# to deny

3447

$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ALLOW" : "CMD_DENY";

3448

3449

$seenevents++;

3450

my $done = 0;

3451

while ( not $done ) {

3452

# what did the grand exalted master tell us to do?

3453

my ($ans, $selected) = UI_PromptUser($q);

3454

3455

if ($ans =~ /^CMD_AUDIT/) {

3456

$audit_toggle = !$audit_toggle;

3457

my $audit = "";

3458

if ($audit_toggle) {

3459

$q->{functions} = [

3460

"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_OFF", "CMD_ABORT", "CMD_FINISHED"

3461

];

3462

$audit = "audit ";

3463

} else {

3464

$q->{functions} = [

3465

"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_NEW", "CMD_ABORT", "CMD_FINISHED"

3466

];

3467

}

3468

$q->{headers} = [];

3469

push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);

3470

push @{ $q->{headers} }, gettext("Capability"), $audit . $capability;

3471

push @{ $q->{headers} }, gettext("Severity"), $severity;

3472

3473

} if ($ans eq "CMD_ALLOW") {

3474

3475

# they picked (a)llow, so...

3476

3477

my $selection = $options[$selected];

3478

$done = 1;

3479

if ($selection &&

3480

$selection =~ m/^#include <(.+)>$/) {

3481

my $deleted = 0;

3482

my $inc = $1;

3483

$deleted = delete_duplicates($sd{$profile}{$hat},

3484

$inc

3485

);

3486

$sd{$profile}{$hat}{include}{$inc} = 1;

3487

3488

$changed{$profile} = 1;

3489

UI_Info(sprintf(

3490

gettext('Adding #include <%s> to profile.'),

3491

$inc));

3492

UI_Info(sprintf(

3493

gettext('Deleted %s previous matching profile entries.'),

3494

$deleted)) if $deleted;

3495

}

3496

# stick the capability into the profile

3497

$sd{$profile}{$hat}{allow}{capability}{$capability}{set} = 1;

3498

$sd{$profile}{$hat}{allow}{capability}{$capability}{audit} = $audit_toggle;

3499

3500

# mark this profile as changed

3501

$changed{$profile} = 1;

3502

$done = 1;

3503

# give a little feedback to the user

3504

UI_Info(sprintf(gettext('Adding capability %s to profile.'), $capability));

3505

} elsif ($ans eq "CMD_DENY") {

3506

$sd{$profile}{$hat}{deny}{capability}{$capability}{set} = 1;

3507

# mark this profile as changed

3508

$changed{$profile} = 1;

3509

UI_Info(sprintf(gettext('Denying capability %s to profile.'), $capability));

3510

$done = 1;

3511

} else {

3512

redo;

3513

}

3514

}

3515

}

3516

3517

# and then step through all of the path entries...

3518

for my $path (sort keys %{ $log{$sdmode}{$profile}{$hat}{path} }) {

3519

3520

my $mode = $log{$sdmode}{$profile}{$hat}{path}{$path};

3521

3522

# do original profile lookup once.

3523

3524

my $allow_mode = 0;

3525

my $allow_audit = 0;

3526

my $deny_mode = 0;

3527

my $deny_audit = 0;

3528

3529

my ($fmode, $famode, $imode, $iamode, @fm, @im, $cm, $am, $cam, @m);

3530

($fmode, $famode, @fm) = rematchfrag($sd{$profile}{$hat}, 'allow', $path);

3531

$allow_mode |= $fmode if $fmode;

3532

$allow_audit |= $famode if $famode;

3533

($imode, $iamode, @im) = match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $path);

3534

$allow_mode |= $imode if $imode;

3535

$allow_audit |= $iamode if $iamode;

3536

3537

($cm, $cam, @m) = rematchfrag($sd{$profile}{$hat}, 'deny', $path);

3538

$deny_mode |= $cm if $cm;

3539

$deny_audit |= $cam if $cam;

3540

($cm, $cam, @m) = match_prof_incs_to_path($sd{$profile}{$hat}, 'deny', $path);

3541

$deny_mode |= $cm if $cm;

3542

$deny_audit |= $cam if $cam;

3543

3544

if ($deny_mode & $AA_MAY_EXEC) {

3545

$deny_mode |= $ALL_AA_EXEC_TYPE;

3546

}

3547

3548

# mask off the modes that have been denied

3549

$mode &= ~$deny_mode;

3550

$allow_mode &= ~$deny_mode;

3551

3552

# if we had an access(X_OK) request or some other kind of

3553

# event that generates a "PERMITTING x" syslog entry,

3554

# first check if it was already dealt with by a i/p/x

3555

# question due to a exec(). if not, ask about adding ix

3556

# permission.

3557

if ($mode & $AA_MAY_EXEC) {

3558

3559

# get rid of the access() markers.

3560

$mode &= (~$ALL_AA_EXEC_TYPE);

3561

3562

unless ($allow_mode & $allow_mode & $AA_MAY_EXEC) {

3563

$mode |= str_to_mode("ix");

3564

}

3565

}

3566

3567

# if we had an mmap(PROT_EXEC) request, first check if we

3568

# already have added an ix rule to the profile

3569

if ($mode & $AA_EXEC_MMAP) {

3570

# ix implies m. don't ask if they want to add an "m"

3571

# rule when we already have a matching ix rule.

3572

if ($allow_mode && contains($allow_mode, "ix")) {

3573

$mode &= (~$AA_EXEC_MMAP);

3574

}

3575

}

3576

3577

next unless $mode;

3578

3579

3580

my @matches;

3581

3582

if ($fmode) {

3583

push @matches, @fm;

3584

}

3585

if ($imode) {

3586

push @matches, @im;

3587

}

3588

3589

unless ($allow_mode && mode_contains($allow_mode, $mode)) {

3590

3591

my $defaultoption = 1;

3592

my @options = ();

3593

3594

# check the path against the available set of include

3595

# files

3596

my @newincludes;

3597

my $includevalid;

3598

for my $incname (keys %include) {

3599

$includevalid = 0;

3600

3601

# don't suggest it if we're already including it,

3602

# that's dumb

3603

next if $sd{$profile}{$hat}{$incname};

3604

3605

# only match includes that can be suggested to

3606

# the user

3607

if ($cfg->{settings}{custom_includes}) {

3608

for my $incm (split(/\s+/,

3609

$cfg->{settings}{custom_includes})

3610

) {

3611

$includevalid = 1 if $incname =~ /$incm/;

3612

}

3613

}

3614

$includevalid = 1 if $incname =~ /abstractions/;

3615

next if ($includevalid == 0);

3616

3617

($cm, $am, @m) = match_include_to_path($incname, 'allow', $path);

3618

if ($cm && mode_contains($cm, $mode)) {

3619

#make sure it doesn't deny $mode

3620

my $dm = match_include_to_path($incname, 'deny', $path);

3621

unless (($mode & $dm) || (grep { $_ eq "/**" } @m)) {

3622

push @newincludes, $incname;

3623

}

3624

}

3625

}

3626

3627

3628

# did any match? add them to the option list...

3629

if (@newincludes) {

3630

push @options,

3631

map { "#include <$_>" }

3632

sort(uniq(@newincludes));

3633

}

3634

3635

# include the literal path in the option list...

3636

push @options, $path;

3637

3638

# match the current path against the globbing list in

3639

# logprof.conf

3640

my @globs = globcommon($path);

3641

if (@globs) {

3642

push @matches, @globs;

3643

}

3644

3645

# suggest any matching globs the user manually entered

3646

for my $userglob (@userglobs) {

3647

push @matches, $userglob

3648

if matchliteral($userglob, $path);

3649

}

3650

3651

# we'll take the cheesy way and order the suggested

3652

# globbing list by length, which is usually right,

3653

# but not always always

3654

push @options,

3655

sort { length($b) <=> length($a) }

3656

grep { $_ ne $path }

3657

uniq(@matches);

3658

$defaultoption = $#options + 1;

3659

3660

my $severity = $sevdb->rank($path, mode_to_str($mode));

3661

3662

my $audit_toggle = 0;

3663

my $owner_toggle = $cfg->{settings}{default_owner_prompt};

3664

my $done = 0;

3665

while (not $done) {

3666

3667

my $q = {};

3668

$q->{headers} = [];

3669

push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);

3670

push @{ $q->{headers} }, gettext("Path"), $path;

3671

3672

# merge in any previous modes from this run

3673

if ($allow_mode) {

3674

my $str;

3675

#print "mode: " . print_mode($mode) . " allow: " . print_mode($allow_mode) . "\n";

3676

$mode |= $allow_mode;

3677

my $tail;

3678

my $prompt_mode;

3679

if ($owner_toggle == 0) {

3680

$prompt_mode = flatten_mode($mode);

3681

$tail = " " . gettext("(owner permissions off)");

3682

} elsif ($owner_toggle == 1) {

3683

$prompt_mode = $mode;

3684

$tail = "";

3685

} elsif ($owner_toggle == 2) {

3686

$prompt_mode = $allow_mode | owner_flatten_mode($mode & ~$allow_mode);

3687

$tail = " " . gettext("(force new perms to owner)");

3688

} else {

3689

$prompt_mode = owner_flatten_mode($mode);

3690

$tail = " " . gettext("(force all rule perms to owner)");

3691

}

3692

3693

if ($audit_toggle == 1) {

3694

$str = mode_to_str_user($allow_mode);

3695

$str .= ", " if ($allow_mode);

3696

$str .= "audit " . mode_to_str_user($prompt_mode & ~$allow_mode) . $tail;

3697

} elsif ($audit_toggle == 2) {

3698

$str = "audit " . mode_to_str_user($prompt_mode) . $tail;

3699

} else {

3700

$str = mode_to_str_user($prompt_mode) . $tail;

3701

}

3702

push @{ $q->{headers} }, gettext("Old Mode"), mode_to_str_user($allow_mode);

3703

push @{ $q->{headers} }, gettext("New Mode"), $str;

3704

} else {

3705

my $str = "";

3706

if ($audit_toggle) {

3707

$str = "audit ";

3708

}

3709

my $tail;

3710

my $prompt_mode;

3711

if ($owner_toggle == 0) {

3712

$prompt_mode = flatten_mode($mode);

3713

$tail = " " . gettext("(owner permissions off)");

3714

} elsif ($owner_toggle == 1) {

3715

$prompt_mode = $mode;

3716

$tail = "";

3717

} else {

3718

$prompt_mode = owner_flatten_mode($mode);

3719

$tail = " " . gettext("(force perms to owner)");

3720

}

3721

$str .= mode_to_str_user($prompt_mode) . $tail;

3722

push @{ $q->{headers} }, gettext("Mode"), $str;

3723

}

3724

push @{ $q->{headers} }, gettext("Severity"), $severity;

3725

3726

$q->{options} = [@options];

3727

$q->{selected} = $defaultoption - 1;

3728

3729

$q->{functions} = [

3730

"CMD_ALLOW", "CMD_DENY", "CMD_GLOB", "CMD_GLOBEXT", "CMD_NEW",

3731

"CMD_ABORT", "CMD_FINISHED", "CMD_OTHER"

3732

];

3733

3734

$q->{default} =

3735

($sdmode eq "PERMITTING")

3736

? "CMD_ALLOW"

3737

: "CMD_DENY";

3738

3739

$seenevents++;

3740

# if they just hit return, use the default answer

3741

my ($ans, $selected) = UI_PromptUser($q);

3742

3743

if ($ans eq "CMD_OTHER") {

3744

3745

($audit_toggle, $owner_toggle) = UI_ask_mode_toggles($audit_toggle, $owner_toggle, $allow_mode);

3746

} elsif ($ans eq "CMD_USER_TOGGLE") {

3747

$owner_toggle++;

3748

$owner_toggle++ if (!$allow_mode && $owner_toggle == 2);

3749

$owner_toggle = 0 if ($owner_toggle > 3);

3750

} elsif ($ans eq "CMD_ALLOW") {

3751

$path = $options[$selected];

3752

$done = 1;

3753

if ($path =~ m/^#include <(.+)>$/) {

3754

my $inc = $1;

3755

my $deleted = 0;

3756

3757

$deleted = delete_duplicates($sd{$profile}{$hat},

3758

$inc );

3759

3760

# record the new entry

3761

$sd{$profile}{$hat}{include}{$inc} = 1;

3762

3763

$changed{$profile} = 1;

3764

UI_Info(sprintf(gettext('Adding #include <%s> to profile.'), $inc));

3765

UI_Info(sprintf(gettext('Deleted %s previous matching profile entries.'), $deleted)) if $deleted;

3766

} else {

3767

if ($sd{$profile}{$hat}{allow}{path}{$path}{mode}) {

3768

$mode |= $sd{$profile}{$hat}{allow}{path}{$path}{mode};

3769

}

3770

3771

my $deleted = 0;

3772

for my $entry (keys %{ $sd{$profile}{$hat}{allow}{path} }) {

3773

3774

next if $path eq $entry;

3775

3776

if (matchregexp($path, $entry)) {

3777

3778

# regexp matches, add it's mode to

3779

# the list to check against

3780

if (mode_contains($mode,

3781

$sd{$profile}{$hat}{allow}{path}{$entry}{mode})) {

3782

delete $sd{$profile}{$hat}{allow}{path}{$entry};

3783

$deleted++;

3784

}

3785

}

3786

}

3787

3788

# record the new entry

3789

if ($owner_toggle == 0) {

3790

$mode = flatten_mode($mode);

3791

} elsif ($owner_toggle == 1) {

3792

$mode = $mode;

3793

} elsif ($owner_toggle == 2) {

3794

$mode = $allow_mode | owner_flatten_mode($mode & ~$allow_mode);

3795

} elsif ($owner_toggle == 3) {

3796

$mode = owner_flatten_mode($mode);

3797

}

3798

$sd{$profile}{$hat}{allow}{path}{$path}{mode} |= $mode;

3799

my $tmpmode = ($audit_toggle == 1) ? $mode & ~$allow_mode : 0;

3800

$tmpmode = ($audit_toggle == 2) ? $mode : $tmpmode;

3801

$sd{$profile}{$hat}{allow}{path}{$path}{audit} |= $tmpmode;

3802

3803

$changed{$profile} = 1;

3804

UI_Info(sprintf(gettext('Adding %s %s to profile.'), $path, mode_to_str_user($mode)));

3805

UI_Info(sprintf(gettext('Deleted %s previous matching profile entries.'), $deleted)) if $deleted;

3806

}

3807

} elsif ($ans eq "CMD_DENY") {

3808

# record the new entry

3809

$sd{$profile}{$hat}{deny}{path}{$path}{mode} |= $mode & ~$allow_mode;

3810

$sd{$profile}{$hat}{deny}{path}{$path}{audit} |= 0;

3811

3812

$changed{$profile} = 1;

3813

3814

# go on to the next entry without saving this

3815

# one

3816

$done = 1;

3817

} elsif ($ans eq "CMD_NEW") {

3818

my $arg = $options[$selected];

3819

if ($arg !~ /^#include/) {

3820

$ans = UI_GetString(gettext("Enter new path: "), $arg);

3821

if ($ans) {

3822

unless (matchliteral($ans, $path)) {

3823

my $ynprompt = gettext("The specified path does not match this log entry:") . "\n\n";

3824

$ynprompt .= " " . gettext("Log Entry") . ": $path\n";

3825

$ynprompt .= " " . gettext("Entered Path") . ": $ans\n\n";

3826

$ynprompt .= gettext("Do you really want to use this path?") . "\n";

3827

3828

# we default to no if they just hit return...

3829

my $key = UI_YesNo($ynprompt, "n");

3830

3831

next if $key eq "n";

3832

}

3833

3834

# save this one for later

3835

push @userglobs, $ans;

3836

3837

push @options, $ans;

3838

$defaultoption = $#options + 1;

3839

}

3840

}

3841

} elsif ($ans eq "CMD_GLOB") {

3842

3843

# do globbing if they don't have an include

3844

# selected

3845

my $newpath = $options[$selected];

3846

chomp $newpath ;

3847

unless ($newpath =~ /^#include/) {

3848

# is this entry directory specific

3849

if ( $newpath =~ m/\/$/ ) {

3850

# do we collapse to /* or /**?

3851

if ($newpath =~ m/\/\*{1,2}\/$/) {

3852

$newpath =~

3853

s/\/[^\/]+\/\*{1,2}\/$/\/\*\*\//;

3854

} else {

3855

$newpath =~ s/\/[^\/]+\/$/\/\*\//;

3856

}

3857

} else {

3858

# do we collapse to /* or /**?

3859

if ($newpath =~ m/\/\*{1,2}$/) {

3860

$newpath =~ s/\/[^\/]+\/\*{1,2}$/\/\*\*/;

3861

} else {

3862

$newpath =~ s/\/[^\/]+$/\/\*/;

3863

}

3864

}

3865

if ($newpath ne $selected) {

3866

push @options, $newpath;

3867

$defaultoption = $#options + 1;

3868

}

3869

}

3870

} elsif ($ans eq "CMD_GLOBEXT") {

3871

3872

# do globbing if they don't have an include

3873

# selected

3874

my $newpath = $options[$selected];

3875

unless ($newpath =~ /^#include/) {

3876

# do we collapse to /*.ext or /**.ext?

3877

if ($newpath =~ m/\/\*{1,2}\.[^\/]+$/) {

3878

$newpath =~ s/\/[^\/]+\/\*{1,2}(\.[^\/]+)$/\/\*\*$1/;

3879

} else {

3880

$newpath =~ s/\/[^\/]+(\.[^\/]+)$/\/\*$1/;

3881

}

3882

if ($newpath ne $selected) {

3883

push @options, $newpath;

3884

$defaultoption = $#options + 1;

3885

}

3886

}

3887

} elsif ($ans =~ /\d/) {

3888

$defaultoption = $ans;

3889

}

3890

}

3891

}

3892

}

3893

3894

# and then step through all of the netdomain entries...

3895

for my $family (sort keys %{$log{$sdmode}

3896

{$profile}

3897

{$hat}

3898

{netdomain}}) {

3899

3900

# TODO - severity handling for net toggles

3901

#my $severity = $sevdb->rank();

3902

for my $sock_type (sort keys %{$log{$sdmode}

3903

{$profile}

3904

{$hat}

3905

{netdomain}

3906

{$family}}) {

3907

3908

# we don't care about it if we've already added it to the

3909

# profile

3910

next if ( profile_known_network($sd{$profile}{$hat},

3911

$family,

3912

$sock_type));

3913

my $defaultoption = 1;

3914

my @options = ();

3915

my @newincludes;

3916

@newincludes = matchnetincludes($sd{$profile}{$hat},

3917

$family,

3918

$sock_type);

3919

3920

my $q = {};

3921

3922

if (@newincludes) {

3923

push @options,

3924

map { "#include <$_>" } sort(uniq(@newincludes));

3925

}

3926

3927

if ( @options ) {

3928

push @options, "network $family $sock_type";

3929

$q->{options} = [@options];

3930

$q->{selected} = $defaultoption - 1;

3931

}

3932

3933

$q->{headers} = [];

3934

push @{ $q->{headers} },

3935

gettext("Profile"),

3936

combine_name($profile, $hat);

3937

push @{ $q->{headers} },

3938

gettext("Network Family"),

3939

$family;

3940

push @{ $q->{headers} },

3941

gettext("Socket Type"),

3942

$sock_type;

3943

3944

my $audit_toggle = 0;

3945

3946

$q->{functions} = [

3947

"CMD_ALLOW",

3948

"CMD_DENY",

3949

"CMD_AUDIT_NEW",

3950

"CMD_ABORT",

3951

"CMD_FINISHED"

3952

];

3953

3954

# complain-mode events default to allow - enforce defaults

3955

# to deny

3956

$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ALLOW" :

3957

"CMD_DENY";

3958

3959

$seenevents++;

3960

3961

# what did the grand exalted master tell us to do?

3962

my $done = 0;

3963

while ( not $done ) {

3964

my ($ans, $selected) = UI_PromptUser($q);

3965

if ($ans =~ /^CMD_AUDIT/) {

3966

$audit_toggle = !$audit_toggle;

3967

my $audit = $audit_toggle ? "audit " : "";

3968

if ($audit_toggle) {

3969

$q->{functions} = [

3970

"CMD_ALLOW",

3971

"CMD_DENY",

3972

"CMD_AUDIT_OFF",

3973

"CMD_ABORT",

3974

"CMD_FINISHED"

3975

];

3976

} else {

3977

$q->{functions} = [

3978

"CMD_ALLOW",

3979

"CMD_DENY",

3980

"CMD_AUDIT_NEW",

3981

"CMD_ABORT",

3982

"CMD_FINISHED"

3983

];

3984

}

3985

$q->{headers} = [];

3986

push @{ $q->{headers} },

3987

gettext("Profile"),

3988

combine_name($profile, $hat);

3989

push @{ $q->{headers} },

3990

gettext("Network Family"),

3991

$audit . $family;

3992

push @{ $q->{headers} },

3993

gettext("Socket Type"),

3994

$sock_type;

3995

} elsif ($ans eq "CMD_ALLOW") {

3996

my $selection = $options[$selected];

3997

$done = 1;

3998

if ($selection &&

3999

$selection =~ m/^#include <(.+)>$/) {

4000

my $inc = $1;

4001

my $deleted = 0;

4002

$deleted = delete_duplicates($sd{$profile}{$hat},

4003

$inc

4004

);

4005

# record the new entry

4006

$sd{$profile}{$hat}{include}{$inc} = 1;

4007

4008

$changed{$profile} = 1;

4009

UI_Info(

4010

sprintf(

4011

gettext('Adding #include <%s> to profile.'),

4012

$inc));

4013

UI_Info(

4014

sprintf(

4015

gettext('Deleted %s previous matching profile entries.'),

4016

$deleted)) if $deleted;

4017

} else {

4018

4019

# stick the whole rule into the profile

4020

$sd{$profile}

4021

{$hat}

4022

{allow}

4023

{netdomain}

4024

{audit}

4025

{$family}

4026

{$sock_type} = $audit_toggle;

4027

4028

$sd{$profile}

4029

{$hat}

4030

{allow}

4031

{netdomain}

4032

{rule}

4033

{$family}

4034

{$sock_type} = 1;

4035

4036

# mark this profile as changed

4037

$changed{$profile} = 1;

4038

4039

# give a little feedback to the user

4040

UI_Info(sprintf(

4041

gettext('Adding network access %s %s to profile.'),

4042

$family,

4043

$sock_type

4044

)

4045

);

4046

}

4047

} elsif ($ans eq "CMD_DENY") {

4048

$done = 1;

4049

# record the new entry

4050

$sd{$profile}

4051

{$hat}

4052

{deny}

4053

{netdomain}

4054

{rule}

4055

{$family}

4056

{$sock_type} = 1;

4057

4058

$changed{$profile} = 1;

4059

UI_Info(sprintf(

4060

gettext('Denying network access %s %s to profile.'),

4061

$family,

4062

$sock_type

4063

)

4064

);

4065

} else {

4066

redo;

4067

}

4068

}

4069

}

4070

}

4071

}

4072

}

4073

}

4074

}

4075

4076

sub delete_net_duplicates($$) {

4077

my ($netrules, $incnetrules) = @_;

4078

my $deleted = 0;

4079

if ( $incnetrules && $netrules ) {

4080

my $incnetglob = defined $incnetrules->{all};

4081

4082

# See which if any profile rules are matched by the include and can be

4083

# deleted

4084

for my $fam ( keys %$netrules ) {

4085

if ( $incnetglob || (ref($incnetrules->{rule}{$fam}) ne "HASH" &&

4086

$incnetrules->{rule}{$fam} == 1)) { # include allows

4087

# all net or

4088

# all fam

4089

if ( ref($netrules->{rule}{$fam}) eq "HASH" ) {

4090

$deleted += ( keys %{$netrules->{rule}{$fam}} );

4091

} else {

4092

$deleted++;

4093

}

4094

delete $netrules->{rule}{$fam};

4095

} elsif ( ref($netrules->{rule}{$fam}) ne "HASH" &&

4096

$netrules->{rule}{$fam} == 1 ){

4097

next; # profile has all family

4098

} else {

4099

for my $socket_type ( keys %{$netrules->{rule}{$fam}} ) {

4100

if ( defined $incnetrules->{$fam}{$socket_type} ) {

4101

delete $netrules->{$fam}{$socket_type};

4102

$deleted++;

4103

}

4104

}

4105

}

4106

}

4107

}

4108

return $deleted;

4109

}

4110

4111

sub delete_cap_duplicates ($$) {

4112

my ($profilecaps, $inccaps) = @_;

4113

my $deleted = 0;

4114

if ( $profilecaps && $inccaps ) {

4115

for my $capname ( keys %$profilecaps ) {

4116

if ( defined $inccaps->{$capname}{set} && $inccaps->{$capname}{set} == 1 ) {

4117

delete $profilecaps->{$capname};

4118

$deleted++;

4119

}

4120

}

4121

}

4122

return $deleted;

4123

}

4124

4125

sub delete_path_duplicates ($$$) {

4126

my ($profile, $incname, $allow) = @_;

4127

my $deleted = 0;

4128

4129

for my $entry (keys %{ $profile->{$allow}{path} }) {

4130

next if $entry eq "#include <$incname>";

4131

my ($cm, $am, @m) = match_include_to_path($incname, $allow, $entry);

4132

if ($cm

4133

&& mode_contains($cm, $profile->{$allow}{path}{$entry}{mode})

4134

&& mode_contains($am, $profile->{$allow}{path}{$entry}{audit}))

4135

{

4136

delete $profile->{$allow}{path}{$entry};

4137

$deleted++;

4138

}

4139

}

4140

return $deleted;

4141

}

4142

4143

sub delete_duplicates (\%$) {

4144

my ( $profile, $incname ) = @_;

4145

my $deleted = 0;

4146

4147

# don't cross delete allow rules covered by denied rules as the coverage

4148

# may not be complete. ie. want to deny a subset of allow, allow a subset

4149

# of deny with different perms.

4150

4151

## network rules

4152

$deleted += delete_net_duplicates($profile->{allow}{netdomain}, $include{$incname}{$incname}{allow}{netdomain});

4153

$deleted += delete_net_duplicates($profile->{deny}{netdomain}, $include{$incname}{$incname}{deny}{netdomain});

4154

4155

## capabilities

4156

$deleted += delete_cap_duplicates($profile->{allow}{capability},

4157

$include{$incname}{$incname}{allow}{capability});

4158

$deleted += delete_cap_duplicates($profile->{deny}{capability},

4159

$include{$incname}{$incname}{deny}{capability});

4160

4161

## paths

4162

$deleted += delete_path_duplicates($profile, $incname, 'allow');

4163

$deleted += delete_path_duplicates($profile, $incname, 'deny');

4164

4165

return $deleted;

4166

}

4167

4168

sub matchnetinclude ($$$) {

4169

my ($incname, $family, $type) = @_;

4170

4171

my @matches;

4172

4173

# scan the include fragments for this profile looking for matches

4174

my @includelist = ($incname);

4175

my @checked;

4176

while (my $name = shift @includelist) {

4177

push @checked, $name;

4178

return 1

4179

if netrules_access_check($include{$name}{$name}{allow}{netdomain}, $family, $type);

4180

# if this fragment includes others, check them too

4181

if (keys %{ $include{$name}{$name}{include} } &&

4182

(grep($name, @checked) == 0) ) {

4183

push @includelist, keys %{ $include{$name}{$name}{include} };

4184

}

4185

}

4186

return 0;

4187

}

4188

4189

sub matchcapincludes (\%$) {

4190

my ($profile, $cap) = @_;

4191

4192

# check the path against the available set of include

4193

# files

4194

my @newincludes;

4195

my $includevalid;

4196

for my $incname (keys %include) {

4197

$includevalid = 0;

4198

4199

# don't suggest it if we're already including it,

4200

# that's dumb

4201

next if $profile->{include}{$incname};

4202

4203

# only match includes that can be suggested to

4204

# the user

4205

if ($cfg->{settings}{custom_includes}) {

4206

for my $incm (split(/\s+/,

4207

$cfg->{settings}{custom_includes})) {

4208

$includevalid = 1 if $incname =~ /$incm/;

4209

}

4210

}

4211

$includevalid = 1 if $incname =~ /abstractions/;

4212

next if ($includevalid == 0);

4213

4214

push @newincludes, $incname

4215

if ( defined $include{$incname}{$incname}{allow}{capability}{$cap}{set} &&

4216

$include{$incname}{$incname}{allow}{capability}{$cap}{set} == 1 );

4217

}

4218

return @newincludes;

4219

}

4220

4221

sub matchnetincludes (\%$$) {

4222

my ($profile, $family, $type) = @_;

4223

4224

# check the path against the available set of include

4225

# files

4226

my @newincludes;

4227

my $includevalid;

4228

for my $incname (keys %include) {

4229

$includevalid = 0;

4230

4231

# don't suggest it if we're already including it,

4232

# that's dumb

4233

next if $profile->{include}{$incname};

4234

4235

# only match includes that can be suggested to

4236

# the user

4237

if ($cfg->{settings}{custom_includes}) {

4238

for my $incm (split(/\s+/, $cfg->{settings}{custom_includes})) {

4239

$includevalid = 1 if $incname =~ /$incm/;

4240

}

4241

}

4242

$includevalid = 1 if $incname =~ /abstractions/;

4243

next if ($includevalid == 0);

4244

4245

push @newincludes, $incname

4246

if matchnetinclude($incname, $family, $type);

4247

}

4248

return @newincludes;

4249

}

4250

4251

4252

sub do_logprof_pass($) {

4253

my $logmark = shift || "";

4254

4255

# zero out the state variables for this pass...

4256

%t = ( );

4257

%transitions = ( );

4258

%seen = ( );

4259

%sd = ( );

4260

%profilechanges = ( );

4261

%prelog = ( );

4262

@log = ( );

4263

%log = ( );

4264

%changed = ( );

4265

%skip = ( );

4266

%filelist = ( );

4267

4268

UI_Info(sprintf(gettext('Reading log entries from %s.'), $filename));

4269

UI_Info(sprintf(gettext('Updating AppArmor profiles in %s.'), $profiledir));

4270

4271

readprofiles();

4272

unless ($sevdb) {

4273

$sevdb = new Immunix::Severity("$confdir/severity.db", gettext("unknown

4274

"));

4275

}

4276

4277

# we need to be able to break all the way out of deep into subroutine calls

4278

# if they select "Finish" so we can take them back out to the genprof prompt

4279

eval {

4280

unless ($repo_cfg || not defined $cfg->{repository}{url}) {

4281

$repo_cfg = read_config("repository.conf");

4282

unless ($repo_cfg->{repository}{enabled} &&

4283

($repo_cfg->{repository}{enabled} eq "yes" ||

4284

$repo_cfg->{repository}{enabled} eq "no")) {

4285

UI_ask_to_enable_repo();

4286

}

4287

}

4288

4289

read_log($logmark);

4290

4291

for my $root (@log) {

4292

handlechildren(undef, undef, $root);

4293

}

4294

4295

for my $pid (sort { $a <=> $b } keys %profilechanges) {

4296

setprocess($pid, $profilechanges{$pid});

4297

}

4298

4299

collapselog();

4300

4301

ask_the_questions();

4302

4303

if ($UI_Mode eq "yast") {

4304

if (not $running_under_genprof) {

4305

if ($seenevents) {

4306

my $w = { type => "wizard" };

4307

$w->{explanation} = gettext("The profile analyzer has completed processing the log files.\n\nAll updated profiles will be reloaded");

4308

$w->{functions} = [ "CMD_ABORT", "CMD_FINISHED" ];

4309

SendDataToYast($w);

4310

my $foo = GetDataFromYast();

4311

} else {

4312

my $w = { type => "wizard" };

4313

$w->{explanation} = gettext("No unhandled AppArmor events were found in the system log.");

4314

$w->{functions} = [ "CMD_ABORT", "CMD_FINISHED" ];

4315

SendDataToYast($w);

4316

my $foo = GetDataFromYast();

4317

}

4318

}

4319

}

4320

};

4321

4322

my $finishing = 0;

4323

if ($@) {

4324

if ($@ =~ /FINISHING/) {

4325

$finishing = 1;

4326

} else {

4327

die $@;

4328

}

4329

}

4330

4331

save_profiles();

4332

4333

if (repo_is_enabled()) {

4334

if ( (not defined $repo_cfg->{repository}{upload}) ||

4335

($repo_cfg->{repository}{upload} eq "later") ) {

4336

UI_ask_to_upload_profiles();

4337

}

4338

if ($repo_cfg->{repository}{upload} eq "yes") {

4339

sync_profiles();

4340

}

4341

@created = ();

4342

}

4343

4344

# if they hit "Finish" we need to tell the caller that so we can exit

4345

# all the way instead of just going back to the genprof prompt

4346

return $finishing ? "FINISHED" : "NORMAL";

4347

}

4348

4349

sub save_profiles() {

4350

# make sure the profile changes we've made are saved to disk...

4351

my @changed = sort keys %changed;

4352

#

4353

# first make sure that profiles in %changed are active (or actual profiles

4354

# in %sd) - this is to handle the sloppiness of setting profiles as changed

4355

# when they are parsed in the case of legacy hat code that we want to write

4356

# out in an updated format

4357

foreach my $profile_name ( keys %changed ) {

4358

if ( ! is_active_profile( $profile_name ) ) {

4359

delete $changed{ $profile_name };

4360

}

4361

}

4362

@changed = sort keys %changed;

4363

4364

if (@changed) {

4365

if ($UI_Mode eq "yast") {

4366

my (@selected_profiles, $title, $explanation, %profile_changes);

4367

foreach my $prof (@changed) {

4368

my $oldprofile = serialize_profile($original_sd{$prof}, $prof);

4369

my $newprofile = serialize_profile($sd{$prof}, $prof);

4370

4371

$profile_changes{$prof} = get_profile_diff($oldprofile,

4372

$newprofile);

4373

}

4374

$explanation = gettext("Select which profile changes you would like to save to the\nlocal profile set");

4375

$title = gettext("Local profile changes");

4376

SendDataToYast(

4377

{

4378

type => "dialog-select-profiles",

4379

title => $title,

4380

explanation => $explanation,

4381

default_select => "true",

4382

get_changelog => "false",

4383

profiles => \%profile_changes

4384

}

4385

);

4386

my ($ypath, $yarg) = GetDataFromYast();

4387

if ($yarg->{STATUS} eq "cancel") {

4388

return;

4389

} else {

4390

my $selected_profiles_ref = $yarg->{PROFILES};

4391

for my $profile (@$selected_profiles_ref) {

4392

writeprofile_ui_feedback($profile);

4393

reload_base($profile);

4394

}

4395

}

4396

} else {

4397

my $q = {};

4398

$q->{title} = "Changed Local Profiles";

4399

$q->{headers} = [];

4400

4401

$q->{explanation} =

4402

gettext( "The following local profiles were changed. Would you like to save them?");

4403

4404

$q->{functions} = [ "CMD_SAVE_CHANGES",

4405

"CMD_VIEW_CHANGES",

4406

"CMD_ABORT", ];

4407

4408

$q->{default} = "CMD_VIEW_CHANGES";

4409

4410

$q->{options} = [@changed];

4411

$q->{selected} = 0;

4412

4413

my ($p, $ans, $arg);

4414

do {

4415

($ans, $arg) = UI_PromptUser($q);

4416

4417

if ($ans eq "CMD_VIEW_CHANGES") {

4418

my $which = $changed[$arg];

4419

my $oldprofile =

4420

serialize_profile($original_sd{$which}, $which);

4421

my $newprofile = serialize_profile($sd{$which}, $which);

4422

display_changes($oldprofile, $newprofile);

4423

}

4424

4425

} until $ans =~ /^CMD_SAVE_CHANGES/;

4426

4427

for my $profile (sort keys %changed) {

4428

writeprofile_ui_feedback($profile);

4429

reload_base($profile);

4430

}

4431

}

4432

}

4433

}

4434

4435

4436

sub get_pager() {

4437

4438

if ( $ENV{PAGER} and (-x "/usr/bin/$ENV{PAGER}" ||

4439

-x "/usr/sbin/$ENV{PAGER}" )

4440

) {

4441

return $ENV{PAGER};

4442

} else {

4443

return "less"

4444

}

4445

}

4446

4447

4448

sub display_text($$) {

4449

my ($header, $body) = @_;

4450

my $pager = get_pager();

4451

if (open(PAGER, "| $pager")) {

4452

print PAGER "$header\n\n$body";

4453

close(PAGER);

4454

}

4455

}

4456

4457

sub get_profile_diff($$) {

4458

my ($oldprofile, $newprofile) = @_;

4459

my $oldtmp = new File::Temp(UNLINK => 0);

4460

print $oldtmp $oldprofile;

4461

close($oldtmp);

4462

4463

my $newtmp = new File::Temp(UNLINK => 0);

4464

print $newtmp $newprofile;

4465

close($newtmp);

4466

4467

my $difftmp = new File::Temp(UNLINK => 0);

4468

my @diff;

4469

system("diff -u $oldtmp $newtmp > $difftmp");

4470

while (<$difftmp>) {

4471

push(@diff, $_) unless (($_ =~ /^(---|\+\+\+)/) ||

4472

($_ =~ /^\@\@.*\@\@$/));

4473

}

4474

unlink($difftmp);

4475

unlink($oldtmp);

4476

unlink($newtmp);

4477

return join("", @diff);

4478

}

4479

4480

sub display_changes($$) {

4481

my ($oldprofile, $newprofile) = @_;

4482

4483

my $oldtmp = new File::Temp( UNLINK => 0 );

4484

print $oldtmp $oldprofile;

4485

close($oldtmp);

4486

4487

my $newtmp = new File::Temp( UNLINK => 0 );

4488

print $newtmp $newprofile;

4489

close($newtmp);

4490

4491

my $difftmp = new File::Temp(UNLINK => 0);

4492

my @diff;

4493

system("diff -u $oldtmp $newtmp > $difftmp");

4494

if ($UI_Mode eq "yast") {

4495

while (<$difftmp>) {

4496

push(@diff, $_) unless (($_ =~ /^(---|\+\+\+)/) ||

4497

($_ =~ /^\@\@.*\@\@$/));

4498

}

4499

UI_LongMessage(gettext("Profile Changes"), join("", @diff));

4500

} else {

4501

system("less $difftmp");

4502

}

4503

4504

unlink($difftmp);

4505

unlink($oldtmp);

4506

unlink($newtmp);

4507

}

4508

4509

sub setprocess ($$) {

4510

my ($pid, $profile) = @_;

4511

4512

# don't do anything if the process exited already...

4513

return unless -e "/proc/$pid/attr/current";

4514

4515

return unless open(CURR, "/proc/$pid/attr/current");

4516

my $current = <CURR>;

4517

return unless $current;

4518

chomp $current;

4519

close(CURR);

4520

4521

# only change null profiles

4522

return unless $current =~ /null(-complain)*-profile/;

4523

4524

return unless open(STAT, "/proc/$pid/stat");

4525

my $stat = <STAT>;

4526

chomp $stat;

4527

close(STAT);

4528

4529

return unless $stat =~ /^\d+ $(\S+)$ /;

4530

my $currprog = $1;

4531

4532

open(CURR, ">/proc/$pid/attr/current") or return;

4533

print CURR "setprofile $profile";

4534

close(CURR);

4535

}

4536

4537

sub collapselog () {

4538

for my $sdmode (keys %prelog) {

4539

for my $profile (keys %{ $prelog{$sdmode} }) {

4540

for my $hat (keys %{ $prelog{$sdmode}{$profile} }) {

4541

for my $path (keys %{ $prelog{$sdmode}{$profile}{$hat}{path} }) {

4542

4543

my $mode = $prelog{$sdmode}{$profile}{$hat}{path}{$path};

4544

4545

# we want to ignore anything from the log that's already

4546

# in the profile

4547

my $combinedmode = 0;

4548

4549

# is it in the original profile?

4550

if ($sd{$profile}{$hat}{allow}{path}{$path}) {

4551

$combinedmode |= $sd{$profile}{$hat}{allow}{path}{$path}{mode};

4552

}

4553

4554

# does path match any regexps in original profile?

4555

$combinedmode |= rematchfrag($sd{$profile}{$hat}, 'allow', $path);

4556

4557

# does path match anything pulled in by includes in

4558

# original profile?

4559

$combinedmode |= match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $path);

4560

4561

# if we found any matching entries, do the modes match?

4562

unless ($combinedmode && mode_contains($combinedmode, $mode)) {

4563

4564

# merge in any previous modes from this run

4565

if ($log{$sdmode}{$profile}{$hat}{$path}) {

4566

$mode |= $log{$sdmode}{$profile}{$hat}{path}{$path};

4567

}

4568

4569

# record the new entry

4570

$log{$sdmode}{$profile}{$hat}{path}{$path} = $mode;

4571

}

4572

}

4573

4574

for my $capability (keys %{ $prelog{$sdmode}{$profile}{$hat}{capability} }) {

4575

4576

# if we don't already have this capability in the profile,

4577

# add it

4578

unless ($sd{$profile}{$hat}{allow}{capability}{$capability}{set}) {

4579

$log{$sdmode}{$profile}{$hat}{capability}{$capability} = 1;

4580

}

4581

}

4582

4583

# Network toggle handling

4584

my $ndref = $prelog{$sdmode}{$profile}{$hat}{netdomain};

4585

for my $family ( keys %{$ndref} ) {

4586

for my $sock_type ( keys %{$ndref->{$family}} ) {

4587

unless ( profile_known_network($sd{$profile}{$hat},

4588

$family, $sock_type)) {

4589

$log{$sdmode}

4590

{$profile}

4591

{$hat}

4592

{netdomain}

4593

{$family}

4594

{$sock_type}=1;

4595

}

4596

}

4597

}

4598

}

4599

}

4600

}

4601

}

4602

4603

sub profilemode ($) {

4604

my $mode = shift;

4605

4606

my $modifier = ($mode =~ m/[iupUP]/)[0];

4607

if ($modifier) {

4608

$mode =~ s/[iupUPx]//g;

4609

$mode .= $modifier . "x";

4610

}

4611

4612

return $mode;

4613

}

4614

4615

# kinky.

4616

sub commonprefix (@) { (join("\0", @_) =~ m/^([^\0]*)[^\0]*(\0\1[^\0]*)*$/)[0] }

4617

sub commonsuffix (@) { reverse(((reverse join("\0", @_)) =~ m/^([^\0]*)[^\0]*(\0\1[^\0]*)*$/)[0]); }

4618

4619

sub uniq (@) {

4620

my %seen;

4621

my @result = sort grep { !$seen{$_}++ } @_;

4622

return @result;

4623

}

4624

4625

our $MODE_MAP_RE = "r|w|l|m|k|a|x|i|u|p|c|n|I|U|P|C|N";

4626

our $LOG_MODE_RE = "r|w|l|m|k|a|x|ix|ux|px|cx|nx|pix|cix|Ix|Ux|Px|PUx|Cx|Nx|Pix|Cix";

4627

our $PROFILE_MODE_RE = "r|w|l|m|k|a|ix|ux|px|cx|pix|cix|Ux|Px|PUx|Cx|Pix|Cix";

4628

our $PROFILE_MODE_NT_RE = "r|w|l|m|k|a|x|ix|ux|px|cx|pix|cix|Ux|Px|PUx|Cx|Pix|Cix";

4629

our $PROFILE_MODE_DENY_RE = "r|w|l|m|k|a|x";

4630

4631

sub split_log_mode($) {

4632

my $mode = shift;

4633

my $user = "";

4634

my $other = "";

4635

4636

if ($mode =~ /(.*?)::(.*)/) {

4637

$user = $1 if ($1);

4638

$other = $2 if ($2);

4639

} else {

4640

$user = $mode;

4641

$other = $mode;

4642

}

4643

return ($user, $other);

4644

}

4645

4646

sub map_log_mode ($) {

4647

my $mode = shift;

4648

return $mode;

4649

# $mode =~ s/(.*l.*)::.*/$1/ge;

4650

# $mode =~ s/.*::(.*l.*)/$1/ge;

4651

# $mode =~ s/:://;

4652

# return $mode;

4653

# return $1;

4654

}

4655

4656

sub hide_log_mode($) {

4657

my $mode = shift;

4658

4659

$mode =~ s/:://;

4660

return $mode;

4661

}

4662

4663

sub validate_log_mode ($) {

4664

my $mode = shift;

4665

4666

return ($mode =~ /^($LOG_MODE_RE)+$/) ? 1 : 0;

4667

}

4668

4669

sub validate_profile_mode ($$$) {

4670

my ($mode, $allow, $nt_name) = @_;

4671

4672

if ($allow eq 'deny') {

4673

return ($mode =~ /^($PROFILE_MODE_DENY_RE)+$/) ? 1 : 0;

4674

} elsif ($nt_name) {

4675

return ($mode =~ /^($PROFILE_MODE_NT_RE)+$/) ? 1 : 0;

4676

}

4677

4678

return ($mode =~ /^($PROFILE_MODE_RE)+$/) ? 1 : 0;

4679

}

4680

4681

# modes internally are stored as a bit Mask

4682

sub sub_str_to_mode($) {

4683

my $str = shift;

4684

my $mode = 0;

4685

4686

return 0 if (not $str);

4687

4688

while ($str =~ s/(${MODE_MAP_RE})//) {

4689

my $tmp = $1;

4690

#print "found mode $1\n";

4691

4692

if ($tmp && $MODE_HASH{$tmp}) {

4693

$mode |= $MODE_HASH{$tmp};

4694

} else {

4695

#print "found mode $tmp\n";

4696

}

4697

}

4698

4699

#my $tmp = mode_to_str($mode);

4700

#print "parsed_mode $mode\n";

4701

return $mode;

4702

}

4703

4704

sub print_mode ($) {

4705

my $mode = shift;

4706

4707

my ($user, $other) = split_mode($mode);

4708

my $str = sub_mode_to_str($user) . "::" . sub_mode_to_str($other);

4709

4710

return $str;

4711

}

4712

4713

sub str_to_mode ($) {

4714

my $str = shift;

4715

4716

return 0 if (not $str);

4717

4718

my ($user, $other) = split_log_mode($str);

4719

4720

#print "str: $str user: $user, other $other\n";

4721

# we only allow user or all

4722

$user = $other if (!$user);

4723

4724

my $mode = sub_str_to_mode($user);

4725

$mode |= (sub_str_to_mode($other) << $AA_OTHER_SHIFT);

4726

4727

#print "user: $user " .sub_str_to_mode($user) . " other: $other " . (sub_str_to_mode($other) << $AA_OTHER_SHIFT) . " mode = $mode\n";

4728

4729

return $mode;

4730

}

4731

4732

sub log_str_to_mode($$$) {

4733

my ($profile, $str, $nt_name) = @_;

4734

4735

my $mode = str_to_mode($str);

4736

4737

# this will cover both nx and nix

4738

if (contains($mode, "Nx")) {

4739

# need to transform to px, cx

4740

4741

if ($nt_name =~ /(.+?)\/\/(.+?)/) {

4742

my ($lprofile, $lhat) = @_;

4743

my $tmode = 0;

4744

if ($profile eq $profile) {

4745

if ($mode & ($AA_MAY_EXEC)) {

4746

$tmode = str_to_mode("Cx::");

4747

}

4748

if ($mode & ($AA_MAY_EXEC << $AA_OTHER_SHIFT)) {

4749

$tmode |= str_to_mode("Cx");

4750

}

4751

$nt_name = $lhat;

4752

} else {

4753

if ($mode & ($AA_MAY_EXEC)) {

4754

$tmode = str_to_mode("Px::");

4755

}

4756

if ($mode & ($AA_MAY_EXEC << $AA_OTHER_SHIFT)) {

4757

$tmode |= str_to_mode("Px");

4758

}

4759

$nt_name = $lhat;

4760

}

4761

$mode = ($mode & ~(str_to_mode("Nx")));

4762

$mode |= $tmode;

4763

}

4764

}

4765

return ($mode, $nt_name);

4766

}

4767

4768

sub split_mode ($) {

4769

my $mode = shift;

4770

4771

my $user = $mode & $AA_USER_MASK;

4772

my $other = ($mode >> $AA_OTHER_SHIFT) & $AA_USER_MASK;

4773

4774

return ($user, $other);

4775

}

4776

4777

sub is_user_mode ($) {

4778

my $mode = shift;

4779

4780

my ($user, $other) = split_mode($mode);

4781

4782

if ($user && !$other) {

4783

return 1;

4784

}

4785

return 0;

4786

}

4787

4788

sub sub_mode_to_str($) {

4789

my $mode = shift;

4790

my $str = "";

4791

4792

# "w" implies "a"

4793

$mode &= (~$AA_MAY_APPEND) if ($mode & $AA_MAY_WRITE);

4794

$str .= "m" if ($mode & $AA_EXEC_MMAP);

4795

$str .= "r" if ($mode & $AA_MAY_READ);

4796

$str .= "w" if ($mode & $AA_MAY_WRITE);

4797

$str .= "a" if ($mode & $AA_MAY_APPEND);

4798

$str .= "l" if ($mode & $AA_MAY_LINK);

4799

$str .= "k" if ($mode & $AA_MAY_LOCK);

4800

if ($mode & $AA_EXEC_UNCONFINED) {

4801

if ($mode & $AA_EXEC_UNSAFE) {

4802

$str .= "u";

4803

} else {

4804

$str .= "U";

4805

}

4806

}

4807

if ($mode & ($AA_EXEC_PROFILE | $AA_EXEC_NT)) {

4808

if ($mode & $AA_EXEC_UNSAFE) {

4809

$str .= "p";

4810

} else {

4811

$str .= "P";

4812

}

4813

}

4814

if ($mode & $AA_EXEC_CHILD) {

4815

if ($mode & $AA_EXEC_UNSAFE) {

4816

$str .= "c";

4817

} else {

4818

$str .= "C";

4819

}

4820

}

4821

$str .= "i" if ($mode & $AA_EXEC_INHERIT);

4822

$str .= "x" if ($mode & $AA_MAY_EXEC);

4823

4824

return $str;

4825

}

4826

4827

sub flatten_mode ($) {

4828

my $mode = shift;

4829

4830

return 0 if (!$mode);

4831

4832

$mode = ($mode & $AA_USER_MASK) | (($mode >> $AA_OTHER_SHIFT) & $AA_USER_MASK);

4833

$mode |= ($mode << $AA_OTHER_SHIFT);

4834

}

4835

4836

sub mode_to_str ($) {

4837

my $mode = shift;

4838

$mode = flatten_mode($mode);

4839

return sub_mode_to_str($mode);

4840

}

4841

4842

sub owner_flatten_mode($) {

4843

my $mode = shift;

4844

$mode = flatten_mode($mode) & $AA_USER_MASK;

4845

return $mode;

4846

}

4847

4848

sub mode_to_str_user ($) {

4849

my $mode = shift;

4850

4851

my ($user, $other) = split_mode($mode);

4852

4853

my $str = "";

4854

$user = 0 if (!$user);

4855

$other = 0 if (!$other);

4856

4857

if ($user & ~$other) {

4858

# more user perms than other

4859

$str = sub_mode_to_str($other). " + " if ($other);

4860

$str .= "owner " . sub_mode_to_str($user & ~$other);

4861

} elsif (is_user_mode($mode)) {

4862

$str = "owner " . sub_mode_to_str($user);

4863

} else {

4864

$str = sub_mode_to_str(flatten_mode($mode));

4865

}

4866

return $str;

4867

}

4868

4869

sub mode_contains ($$) {

4870

my ($mode, $subset) = @_;

4871

4872

# "w" implies "a"

4873

if ($mode & $AA_MAY_WRITE) {

4874

$mode |= $AA_MAY_APPEND;

4875

}

4876

if ($mode & ($AA_MAY_WRITE << $AA_OTHER_SHIFT)) {

4877

$mode |= ($AA_MAY_APPEND << $AA_OTHER_SHIFT);

4878

}

4879

4880

# "?ix" implies "m"

4881

if ($mode & $AA_EXEC_INHERIT) {

4882

$mode |= $AA_EXEC_MMAP;

4883

}

4884

if ($mode & ($AA_EXEC_INHERIT << $AA_OTHER_SHIFT)) {

4885

$mode |= ($AA_EXEC_MMAP << $AA_OTHER_SHIFT);

4886

}

4887

4888

return (($mode & $subset) == $subset);

4889

}

4890

4891

sub contains ($$) {

4892

my ($mode, $str) = @_;

4893

4894

return mode_contains($mode, str_to_mode($str));

4895

}

4896

4897

# isSkippableFile - return true if filename matches something that

4898

# should be skipped (rpm backup files, dotfiles, emacs backup files

4899

# Annoyingly, this needs to be kept in sync with the skipped files

4900

# in the apparmor initscript.

4901

sub isSkippableFile($) {

4902

my $path = shift;

4903

4904

return ($path =~ /(^|\/)\.[^\/]*$/

4905

|| $path =~ /\.rpm(save|new)$/

4906

|| $path =~ /\.dpkg-(old|new)$/

4907

|| $path =~ /\.swp$/

4908

|| $path =~ /\~$/);

4909

}

4910

4911

# isSkippableDir - return true if directory matches something that

4912

# should be skipped (cache directory, symlink directories, etc.)

4913

sub isSkippableDir($) {

4914

my $path = shift;

4915

4916

return ($path eq "disable"

4917

|| $path eq "cache"

4918

|| $path eq "force-complain");

4919

}

4920

4921

sub checkIncludeSyntax($) {

4922

my $errors = shift;

4923

4924

if (opendir(SDDIR, $profiledir)) {

4925

my @incdirs = grep { (!/^\./) && (-d "$profiledir/$_") } readdir(SDDIR);

4926

close(SDDIR);

4927

while (my $id = shift @incdirs) {

4928

next if isSkippableDir($id);

4929

if (opendir(SDDIR, "$profiledir/$id")) {

4930

for my $path (grep { !/^\./ } readdir(SDDIR)) {

4931

chomp($path);

4932

next if isSkippableFile($path);

4933

if (-f "$profiledir/$id/$path") {

4934

my $file = "$id/$path";

4935

$file =~ s/$profiledir\///;

4936

eval { loadinclude($file); };

4937

if ( defined $@ && $@ ne "" ) {

4938

push @$errors, $@;

4939

}

4940

} elsif (-d "$id/$path") {

4941

push @incdirs, "$id/$path";

4942

}

4943

}

4944

closedir(SDDIR);

4945

}

4946

}

4947

}

4948

return $errors;

4949

}

4950

4951

sub checkProfileSyntax ($) {

4952

my $errors = shift;

4953

4954

# Check the syntax of profiles

4955

4956

opendir(SDDIR, $profiledir)

4957

or fatal_error "Can't read AppArmor profiles in $profiledir.";

4958

for my $file (grep { -f "$profiledir/$_" } readdir(SDDIR)) {

4959

next if isSkippableFile($file);

4960

my $err = readprofile("$profiledir/$file", \&printMessageErrorHandler, 1);

4961

if (defined $err and $err ne "") {

4962

push @$errors, $err;

4963

}

4964

}

4965

closedir(SDDIR);

4966

return $errors;

4967

}

4968

4969

sub printMessageErrorHandler ($) {

4970

my $message = shift;

4971

return $message;

4972

}

4973

4974

sub readprofiles () {

4975

opendir(SDDIR, $profiledir)

4976

or fatal_error "Can't read AppArmor profiles in $profiledir.";

4977

for my $file (grep { -f "$profiledir/$_" } readdir(SDDIR)) {

4978

next if isSkippableFile($file);

4979

readprofile("$profiledir/$file", \&fatal_error, 1);

4980

}

4981

closedir(SDDIR);

4982

}

4983

4984

sub readinactiveprofiles () {

4985

return if ( ! -e $extraprofiledir );

4986

opendir(ESDDIR, $extraprofiledir) or

4987

fatal_error "Can't read AppArmor profiles in $extraprofiledir.";

4988

for my $file (grep { -f "$extraprofiledir/$_" } readdir(ESDDIR)) {

4989

next if $file =~ /\.rpm(save|new)|README$/;

4990

readprofile("$extraprofiledir/$file", \&fatal_error, 0);

4991

}

4992

closedir(ESDDIR);

4993

}

4994

4995

sub readprofile ($$$) {

4996

my $file = shift;

4997

my $error_handler = shift;

4998

my $active_profile = shift;

4999

if (open(SDPROF, "$file")) {

5000

local $/;

5001

my $data = <SDPROF>;

5002

close(SDPROF);

5003

5004

eval {

5005

my $profile_data = parse_profile_data($data, $file, 0);

5006

if ($profile_data && $active_profile) {

5007

attach_profile_data(\%sd, $profile_data);

5008

attach_profile_data(\%original_sd, $profile_data);

5009

} elsif ( $profile_data ) {

5010

attach_profile_data(\%extras, $profile_data);

5011

}

5012

};

5013

5014

# if there were errors loading the profile, call the error handler

5015

if ($@) {

5016

$@ =~ s/\n$//;

5017

return &$error_handler($@);

5018

}

5019

} else {

5020

$DEBUGGING && debug "readprofile: can't read $file - skipping";

5021

}

5022

}

5023

5024

sub attach_profile_data($$) {

5025

my ($profiles, $profile_data) = @_;

5026

5027

# make deep copies of the profile data so that if we change one set of

5028

# profile data, we're not changing others because of sharing references

5029

for my $p ( keys %$profile_data) {

5030

$profiles->{$p} = dclone($profile_data->{$p});

5031

}

5032

}

5033

5034

sub parse_profile_data($$$) {

5035

my ($data, $file, $do_include) = @_;

5036

5037

5038

my ($profile_data, $profile, $hat, $in_contained_hat, $repo_data,

5039

@parsed_profiles);

5040

my $initial_comment = "";

5041

5042

if ($do_include) {

5043

$profile = $file;

5044

$hat = $file;

5045

}

5046

5047

for (split(/\n/, $data)) {

5048

chomp;

5049

5050

# we don't care about blank lines

5051

next if /^\s*$/;

5052

5053

# start of a profile...

5054

if (m/^\s*(("??\/.+?"??)|(profile\s+("??.+?"??)))\s+((flags=)?$(.+)$\s+)*\{\s*(#.*)?$/) {

5055

# if we run into the start of a profile while we're already in a

5056

# profile, something's wrong...

5057

if ($profile) {

5058

unless (($profile eq $hat) and $4) {

5059

die "$profile profile in $file contains syntax errors.\n";

5060

}

5061

}

5062

5063

# we hit the start of a profile, keep track of it...

5064

if ($profile && ($profile eq $hat) && $4) {

5065

# local profile

5066

$hat = $4;

5067

$in_contained_hat = 1;

5068

$profile_data->{$profile}{$hat}{profile} = 1;

5069

} else {

5070

$profile = $2 || $4;

5071

# hat is same as profile name if we're not in a hat

5072

($profile, $hat) = split /\/\//, $profile;

5073

$in_contained_hat = 0;

5074

if ($hat) {

5075

$profile_data->{$profile}{$hat}{external} = 1;

5076

}

5077

5078

$hat ||= $profile;

5079

}

5080

5081

my $flags = $7;

5082

5083

# deal with whitespace in profile and hat names.

5084

$profile = strip_quotes($profile);

5085

$hat = strip_quotes($hat) if $hat;

5086

5087

# save off the name and filename

5088

$profile_data->{$profile}{$hat}{name} = $profile;

5089

$profile_data->{$profile}{$hat}{filename} = $file;

5090

$filelist{$file}{profiles}{$profile}{$hat} = 1;

5091

5092

# keep track of profile flags

5093

$profile_data->{$profile}{$hat}{flags} = $flags;

5094

5095

$profile_data->{$profile}{$hat}{allow}{netdomain} = { };

5096

$profile_data->{$profile}{$hat}{allow}{path} = { };

5097

5098

# store off initial comment if they have one

5099

$profile_data->{$profile}{$hat}{initial_comment} = $initial_comment

5100

if $initial_comment;

5101

$initial_comment = "";

5102

5103

if ($repo_data) {

5104

$profile_data->{$profile}{$profile}{repo}{url} = $repo_data->{url};

5105

$profile_data->{$profile}{$profile}{repo}{user} = $repo_data->{user};

5106

$profile_data->{$profile}{$profile}{repo}{id} = $repo_data->{id};

5107

$repo_data = undef;

5108

}

5109

5110

} elsif (m/^\s*\}\s*(#.*)?$/) { # end of a profile...

5111

5112

# if we hit the end of a profile when we're not in one, something's

5113

# wrong...

5114

if (not $profile) {

5115

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5116

}

5117

5118

if ($in_contained_hat) {

5119

$hat = $profile;

5120

$in_contained_hat = 0;

5121

} else {

5122

push @parsed_profiles, $profile;

5123

# mark that we're outside of a profile now...

5124

$profile = undef;

5125

}

5126

5127

$initial_comment = "";

5128

5129

} elsif (m/^\s*(audit\s+)?(deny\s+)?capability\s+(\S+)\s*,\s*(#.*)?$/) { # capability entry

5130

if (not $profile) {

5131

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5132

}

5133

5134

my $audit = $1 ? 1 : 0;

5135

my $allow = $2 ? 'deny' : 'allow';

5136

$allow = 'deny' if ($2);

5137

my $capability = $3;

5138

$profile_data->{$profile}{$hat}{$allow}{capability}{$capability}{set} = 1;

5139

$profile_data->{$profile}{$hat}{$allow}{capability}{$capability}{audit} = $audit;

5140

} elsif (m/^\s*set capability\s+(\S+)\s*,\s*(#.*)?$/) { # capability entry

5141

if (not $profile) {

5142

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5143

}

5144

5145

my $capability = $1;

5146

$profile_data->{$profile}{$hat}{set_capability}{$capability} = 1;

5147

5148

} elsif (m/^\s*(audit\s+)?(deny\s+)?link\s+(((subset)|(<=))\s+)?([\"\@\/].*?"??)\s+->\s*([\"\@\/].*?"??)\s*,\s*(#.*)?$/) { # for now just keep link

5149

if (not $profile) {

5150

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5151

}

5152

my $audit = $1 ? 1 : 0;

5153

my $allow = $2 ? 'deny' : 'allow';

5154

5155

my $subset = $4;

5156

my $link = strip_quotes($7);

5157

my $value = strip_quotes($8);

5158

$profile_data->{$profile}{$hat}{$allow}{link}{$link}{to} = $value;

5159

$profile_data->{$profile}{$hat}{$allow}{link}{$link}{mode} |= $AA_MAY_LINK;

5160

if ($subset) {

5161

$profile_data->{$profile}{$hat}{$allow}{link}{$link}{mode} |= $AA_LINK_SUBSET;

5162

}

5163

if ($audit) {

5164

$profile_data->{$profile}{$hat}{$allow}{link}{$link}{audit} |= $AA_LINK_SUBSET;

5165

} else {

5166

$profile_data->{$profile}{$hat}{$allow}{link}{$link}{audit} |= 0;

5167

}

5168

5169

} elsif (m/^\s*change_profile\s+->\s*("??.+?"??),(#.*)?$/) { # for now just keep change_profile

5170

if (not $profile) {

5171

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5172

}

5173

my $cp = strip_quotes($1);

5174

5175

$profile_data->{$profile}{$hat}{change_profile}{$cp} = 1;

5176

} elsif (m/^\s*alias\s+("??.+?"??)\s+->\s*("??.+?"??)\s*,(#.*)?$/) { # never do anything with aliases just keep them

5177

my $from = strip_quotes($1);

5178

my $to = strip_quotes($2);

5179

5180

if ($profile) {

5181

$profile_data->{$profile}{$hat}{alias}{$from} = $to;

5182

} else {

5183

unless (exists $filelist{$file}) {

5184

$filelist{$file} = { };

5185

}

5186

$filelist{$file}{alias}{$from} = $to;

5187

}

5188

5189

} elsif (m/^\s*set\s+rlimit\s+(.+)\s+<=\s*(.+)\s*,(#.*)?$/) { # never do anything with rlimits just keep them

5190

if (not $profile) {

5191

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5192

}

5193

my $from = $1;

5194

my $to = $2;

5195

5196

$profile_data->{$profile}{$hat}{rlimit}{$from} = $to;

5197

5198

} elsif (/^\s*(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*=\s*(true|false)\s*,?\s*(#.*)?$/i) { # boolean definition

5199

if (not $profile) {

5200

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5201

}

5202

my $bool_var = $1;

5203

my $value = $2;

5204

5205

$profile_data->{$profile}{$hat}{lvar}{$bool_var} = $value;

5206

} elsif (/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\+?=\s*(.+?)\s*,?\s*(#.*)?$/) { # variable additions both += and = doesn't mater

5207

my $list_var = strip_quotes($1);

5208

my $value = strip_quotes($2);

5209

5210

if ($profile) {

5211

unless (exists $profile_data->{$profile}{$hat}{lvar}) {

5212

# create lval hash by sticking an empty list into list_var

5213

my @empty = ();

5214

$profile_data->{$profile}{$hat}{lvar}{$list_var} = \@empty;

5215

}

5216

5217

store_list_var($profile_data->{$profile}{$hat}{lvar}, $list_var, $value);

5218

} else {

5219

unless (exists $filelist{$file}{lvar}) {

5220

# create lval hash by sticking an empty list into list_var

5221

my @empty = ();

5222

$filelist{$file}{lvar}{$list_var} = \@empty;

5223

}

5224

5225

store_list_var($filelist{$file}{lvar}, $list_var, $value);

5226

}

5227

} elsif (m/^\s*if\s+(not\s+)?(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*\{\s*(#.*)?$/) { # conditional -- boolean

5228

} elsif (m/^\s*if\s+(not\s+)?defined\s+(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\{\s*(#.*)?$/) { # conditional -- variable defined

5229

} elsif (m/^\s*if\s+(not\s+)?defined\s+(\$\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\{\s*(#.*)?$/) { # conditional -- boolean defined

5230

} elsif (m/^\s*(audit\s+)?(deny\s+)?(owner\s+)?([\"\@\/].*?)\s+(\S+)(\s+->\s*(.*?))?\s*,\s*(#.*)?$/) { # path entry

5231

if (not $profile) {

5232

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5233

}

5234

5235

my $audit = $1 ? 1 : 0;

5236

my $allow = $2 ? 'deny' : 'allow';

5237

my $user = $3 ? 1 : 0;

5238

my ($path, $mode, $nt_name) = ($4, $5, $7);

5239

5240

# strip off any trailing spaces.

5241

$path =~ s/\s+$//;

5242

$nt_name =~ s/\s+$// if $nt_name;

5243

5244

$path = strip_quotes($path);

5245

$nt_name = strip_quotes($nt_name) if $nt_name;

5246

5247

# make sure they don't have broken regexps in the profile

5248

my $p_re = convert_regexp($path);

5249

eval { "foo" =~ m/^$p_re$/; };

5250

if ($@) {

5251

die sprintf(gettext('Profile %s contains invalid regexp %s.'),

5252

$file, $path) . "\n";

5253

}

5254

5255

if (!validate_profile_mode($mode, $allow, $nt_name)) {

5256

fatal_error(sprintf(gettext('Profile %s contains invalid mode %s.'), $file, $mode));

5257

}

5258

5259

my $tmpmode;

5260

if ($user) {

5261

$tmpmode = str_to_mode("${mode}::");

5262

} else {

5263

$tmpmode = str_to_mode($mode);

5264

}

5265

5266

$profile_data->{$profile}{$hat}{$allow}{path}{$path}{mode} |= $tmpmode;

5267

$profile_data->{$profile}{$hat}{$allow}{path}{$path}{to} = $nt_name if $nt_name;

5268

if ($audit) {

5269

$profile_data->{$profile}{$hat}{$allow}{path}{$path}{audit} |= $tmpmode;

5270

} else {

5271

$profile_data->{$profile}{$hat}{$allow}{path}{$path}{audit} |= 0;

5272

}

5273

} elsif (m/^\s*#include <(.+)>\s*$/) { # include stuff

5274

my $include = $1;

5275

5276

if ($profile) {

5277

$profile_data->{$profile}{$hat}{include}{$include} = 1;

5278

} else {

5279

unless (exists $filelist{$file}) {

5280

$filelist{$file} = { };

5281

}

5282

$filelist{$file}{include}{$include} = 1;

5283

}

5284

5285

# include is a dir

5286

if (-d "$profiledir/$include") {

5287

if (opendir(SDINCDIR, "$profiledir/$include")) {

5288

for my $path (readdir(SDINCDIR)) {

5289

chomp($path);

5290

next if isSkippableFile($path);

5291

if (-f "$profiledir/$include/$path") {

5292

my $file = "$include/$path";

5293

$file =~ s/$profiledir\///;

5294

my $ret = eval { loadinclude($file); };

5295

if ($@) { die $@; }

5296

return $ret if ( $ret != 0 );

5297

}

5298

}

5299

}

5300

closedir(SDINCDIR);

5301

} else {

5302

# try to load the include...

5303

my $ret = eval { loadinclude($include); };

5304

# propagate errors up the chain

5305

if ($@) { die $@; }

5306

return $ret if ( $ret != 0 );

5307

}

5308

} elsif (/^\s*(audit\s+)?(deny\s+)?network(.*)/) {

5309

if (not $profile) {

5310

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5311

}

5312

my $audit = $1 ? 1 : 0;

5313

my $allow = $2 ? 'deny' : 'allow';

5314

my $network = $3;

5315

5316

unless ($profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}) {

5317

$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule} = { };

5318

}

5319

5320

if ($network =~ /\s+(\S+)\s+(\S+)\s*,\s*(#.*)?$/ ) {

5321

my $fam = $1;

5322

my $type = $2;

5323

$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{$fam}{$type} = 1;

5324

$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{$fam}{$type} = $audit;

5325

} elsif ( $network =~ /\s+(\S+)\s*,\s*(#.*)?$/ ) {

5326

my $fam = $1;

5327

$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{$fam} = 1;

5328

$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{$fam} = $audit;

5329

} else {

5330

$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{all} = 1;

5331

$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{all} = 1;

5332

}

5333

} elsif (/^\s*(tcp_connect|tcp_accept|udp_send|udp_receive)/) {

5334

# just ignore and drop old style network

5335

# die sprintf(gettext('%s contains old style network rules.'), $file) . "\n";

5336

5337

} elsif (m/^\s*\^(\"??.+?\"??)\s*,\s*(#.*)?$/) {

5338

if (not $profile) {

5339

die "$file contains syntax errors.";

5340

}

5341

# change_hat declaration - needed to change_hat to an external

5342

# hat

5343

$hat = $1;

5344

$hat = $1 if $hat =~ /^"(.+)"$/;

5345

5346

#store we have a declaration if the hat hasn't been seen

5347

$profile_data->{$profile}{$hat}{'declared'} = 1

5348

unless exists($profile_data->{$profile}{$hat}{declared});

5349

5350

} elsif (m/^\s*\^(\"??.+?\"??)\s+((flags=)?$(.+)$\s+)*\{\s*(#.*)?$/) {

5351

# start of embedded hat syntax hat definition

5352

# read in and mark as changed so that will be written out in the new

5353

# format

5354

5355

# if we hit the start of a contained hat when we're not in a profile

5356

# something is wrong...

5357

if (not $profile) {

5358

die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";

5359

}

5360

5361

$in_contained_hat = 1;

5362

5363

# we hit the start of a hat inside the current profile

5364

$hat = $1;

5365

my $flags = $4;

5366

5367

# strip quotes.

5368

$hat = $1 if $hat =~ /^"(.+)"$/;

5369

5370

# keep track of profile flags

5371

$profile_data->{$profile}{$hat}{flags} = $flags;

5372

# we have seen more than a declaration so clear it

5373

$profile_data->{$profile}{$hat}{'declared'} = 0;

5374

$profile_data->{$profile}{$hat}{allow}{path} = { };

5375

$profile_data->{$profile}{$hat}{allow}{netdomain} = { };

5376

5377

# store off initial comment if they have one

5378

$profile_data->{$profile}{$hat}{initial_comment} = $initial_comment

5379

if $initial_comment;

5380

$initial_comment = "";

5381

#don't mark profile as changed just because it has an embedded

5382

#hat.

5383

#$changed{$profile} = 1;

5384

5385

$filelist{$file}{profiles}{$profile}{$hat} = 1;

5386

5387

} elsif (/^\s*\#/) {

5388

# we only currently handle initial comments

5389

if (not $profile) {

5390

# ignore vim syntax highlighting lines

5391

next if /^\s*\# vim:syntax/;

5392

# ignore Last Modified: lines

5393

next if /^\s*\# Last Modified:/;

5394

if (/^\s*\# REPOSITORY: (\S+) (\S+) (\S+)$/) {

5395

$repo_data = { url => $1, user => $2, id => $3 };

5396

} elsif (/^\s*\# REPOSITORY: NEVERSUBMIT$/) {

5397

$repo_data = { neversubmit => 1 };

5398

} else {

5399

$initial_comment .= "$_\n";

5400

}

5401

}

5402

} else {

5403

# we hit something we don't understand in a profile...

5404

die sprintf(gettext('%s contains syntax errors. Line [%s]'), $file, $_) . "\n";

5405

}

5406

}

5407

5408

#

5409

# Cleanup : add required hats if not present in the

5410

# parsed profiles

5411

#

5412

if (not $do_include) {

5413

for my $hatglob (keys %{$cfg->{required_hats}}) {

5414

for my $parsed_profile ( sort @parsed_profiles ) {

5415

if ($parsed_profile =~ /$hatglob/) {

5416

for my $hat (split(/\s+/, $cfg->{required_hats}{$hatglob})) {

5417

unless ($profile_data->{$parsed_profile}{$hat}) {

5418

$profile_data->{$parsed_profile}{$hat} = { };

5419

}

5420

}

5421

}

5422

}

5423

}

5424

5425

} # if we're still in a profile when we hit the end of the file, it's bad

5426

if ($profile and not $do_include) {

5427

die "Reached the end of $file while we were still inside the $profile profile.\n";

5428

}

5429

5430

return $profile_data;

5431

}

5432

5433

sub eliminate_duplicates(@) {

5434

my @data =@_;

5435

5436

my %set = map { $_ => 1 } @_;

5437

@data = keys %set;

5438

5439

return @data;

5440

}

5441

5442

sub separate_vars($) {

5443

my $vs = shift;

5444

my @data;

5445

5446

# while ($vs =~ /\s*(((\"([^\"]|\\\"))+?\")|\S*)\s*(.*)$/) {

5447

while ($vs =~ /\s*((\".+?\")|([^\"]\S+))\s*(.*)$/) {

5448

my $tmp = $1;

5449

push @data, strip_quotes($tmp);

5450

$vs = $4;

5451

}

5452

5453

return @data;

5454

}

5455

5456

sub is_active_profile ($) {

5457

my $pname = shift;

5458

if ( $sd{$pname} ) {

5459

return 1;

5460

} else {

5461

return 0;

5462

}

5463

}

5464

5465

sub store_list_var (\%$$) {

5466

my ($vars, $list_var, $value) = @_;

5467

5468

my @vlist = (separate_vars($value));

5469

5470

# if (exists $profile_data->{$profile}{$hat}{lvar}{$list_var}) {

5471

# @vlist = (@vlist, @{$profile_data->{$profile}{$hat}{lvar}{$list_var}});

5472

# }

5473

#

5474

# @vlist = eliminate_duplicates(@vlist);

5475

# $profile_data->{$profile}{$hat}{lvar}{$list_var} = \@vlist;

5476

5477

if (exists $vars->{$list_var}) {

5478

@vlist = (@vlist, @{$vars->{$list_var}});

5479

}

5480

5481

@vlist = eliminate_duplicates(@vlist);

5482

$vars->{$list_var} = \@vlist;

5483

5484

5485

}

5486

5487

sub strip_quotes ($) {

5488

my $data = shift;

5489

$data = $1 if $data =~ /^\"(.*)\"$/;

5490

return $data;

5491

}

5492

5493

sub quote_if_needed ($) {

5494

my $data = shift;

5495

$data = "\"$data\"" if $data =~ /\s/;

5496

5497

return $data;

5498

}

5499

5500

sub escape ($) {

5501

my $dangerous = shift;

5502

5503

$dangerous = strip_quotes($dangerous);

5504

5505

$dangerous =~ s/((?<!\\))"/$1\\"/g;

5506

if ($dangerous =~ m/(\s|^$|")/) {

5507

$dangerous = "\"$dangerous\"";

5508

}

5509

5510

return $dangerous;

5511

}

5512

5513

sub writeheader ($$$$$) {

5514

my ($profile_data, $depth, $name, $embedded_hat, $write_flags) = @_;

5515

5516

my $pre = ' ' x $depth;

5517

my @data;

5518

# deal with whitespace in profile names...

5519

$name = quote_if_needed($name);

5520

5521

$name = "profile $name" if ((!$embedded_hat && $name =~ /^[^\/]|^"[^\/]/)

5522

|| ($embedded_hat && $name =~/^[^^]/));

5523

5524

#push @data, "#include <tunables/global>" unless ( $is_hat );

5525

if ($write_flags and $profile_data->{flags}) {

5526

push @data, "${pre}$name flags=($profile_data->{flags}) {";

5527

} else {

5528

push @data, "${pre}$name {";

5529

}

5530

5531

return @data;

5532

}

5533

5534

sub qin_trans ($) {

5535

my $value = shift;

5536

return quote_if_needed($value);

5537

}

5538

5539

sub write_single ($$$$$$) {

5540

my ($profile_data, $depth, $allow, $name, $prefix, $tail) = @_;

5541

my $ref;

5542

my @data;

5543

5544

if ($allow) {

5545

$ref = $profile_data->{$allow};

5546

if ($allow eq 'deny') {

5547

$allow .= " ";

5548

} else {

5549

$allow = "";

5550

}

5551

} else {

5552

$ref = $profile_data;

5553

$allow = "";

5554

}

5555

5556

my $pre = " " x $depth;

5557

5558

5559

# dump out the data

5560

if (exists $ref->{$name}) {

5561

for my $key (sort keys %{$ref->{$name}}) {

5562

my $qkey = quote_if_needed($key);

5563

push @data, "${pre}${allow}${prefix}${qkey}${tail}";

5564

}

5565

push @data, "" if keys %{$ref->{$name}};

5566

}

5567

5568

return @data;

5569

}

5570

5571

sub write_pair ($$$$$$$$) {

5572

my ($profile_data, $depth, $allow, $name, $prefix, $sep, $tail, $fn) = @_;

5573

my $ref;

5574

my @data;

5575

5576

if ($allow) {

5577

$ref = $profile_data->{$allow};

5578

if ($allow eq 'deny') {

5579

$allow .= " ";

5580

} else {

5581

$allow = "";

5582

}

5583

} else {

5584

$ref = $profile_data;

5585

$allow = "";

5586

}

5587

5588

my $pre = " " x $depth;

5589

5590

# dump out the data

5591

if (exists $ref->{$name}) {

5592

for my $key (sort keys %{$ref->{$name}}) {

5593

my $value = &{$fn}($ref->{$name}{$key});

5594

push @data, "${pre}${allow}${prefix}${key}${sep}${value}${tail}";

5595

}

5596

push @data, "" if keys %{$ref->{$name}};

5597

}

5598

5599

return @data;

5600

}

5601

5602

sub writeincludes ($$) {

5603

my ($prof_data, $depth) = @_;

5604

5605

return write_single($prof_data, $depth,'', 'include', "#include <", ">");

5606

}

5607

5608

sub writechange_profile ($$) {

5609

my ($prof_data, $depth) = @_;

5610

5611

return write_single($prof_data, $depth, '', 'change_profile', "change_profile -> ", ",");

5612

}

5613

5614

sub writealiases ($$) {

5615

my ($prof_data, $depth) = @_;

5616

5617

return write_pair($prof_data, $depth, '', 'alias', "alias ", " -> ", ",", \&qin_trans);

5618

}

5619

5620

sub writerlimits ($$) {

5621

my ($prof_data, $depth) = @_;

5622

5623

return write_pair($prof_data, $depth, '', 'rlimit', "set rlimit ", " <= ", ",", \&qin_trans);

5624

}

5625

5626

# take a list references and process it

5627

sub var_transform($) {

5628

my $ref = shift;

5629

my @in = @{$ref};

5630

my @data;

5631

5632

foreach my $value (@in) {

5633

push @data, quote_if_needed($value);

5634

}

5635

5636

return join " ", @data;

5637

}

5638

5639

sub writelistvars ($$) {

5640

my ($prof_data, $depth) = @_;

5641

5642

return write_pair($prof_data, $depth, '', 'lvar', "", " = ", "", \&var_transform);

5643

}

5644

5645

sub writecap_rules ($$$) {

5646

my ($profile_data, $depth, $allow) = @_;

5647

5648

my $allowstr = $allow eq 'deny' ? 'deny ' : '';

5649

my $pre = " " x $depth;

5650

5651

my @data;

5652

if (exists $profile_data->{$allow}{capability}) {

5653

for my $cap (sort keys %{$profile_data->{$allow}{capability}}) {

5654

my $audit = ($profile_data->{$allow}{capability}{$cap}{audit}) ? 'audit ' : '';

5655

if ($profile_data->{$allow}{capability}{$cap}{set}) {

5656

push @data, "${pre}${audit}${allowstr}capability ${cap},";

5657

}

5658

}

5659

push @data, "";

5660

}

5661

5662

return @data;

5663

}

5664

5665

sub writecapabilities ($$) {

5666

my ($prof_data, $depth) = @_;

5667

my @data;

5668

push @data, write_single($prof_data, $depth, '', 'set_capability', "set capability ", ",");

5669

push @data, writecap_rules($prof_data, $depth, 'deny');

5670

push @data, writecap_rules($prof_data, $depth, 'allow');

5671

return @data;

5672

}

5673

5674

sub writenet_rules ($$$) {

5675

my ($profile_data, $depth, $allow) = @_;

5676

5677

my $allowstr = $allow eq 'deny' ? 'deny ' : '';

5678

5679

my $pre = " " x $depth;

5680

my $audit = "";

5681

5682

my @data;

5683

# dump out the netdomain entries...

5684

if (exists $profile_data->{$allow}{netdomain}) {

5685

if ( $profile_data->{$allow}{netdomain}{rule} &&

5686

$profile_data->{$allow}{netdomain}{rule} eq 'all') {

5687

$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{all};

5688

push @data, "${pre}${audit}network,";

5689

} else {

5690

for my $fam (sort keys %{$profile_data->{$allow}{netdomain}{rule}}) {

5691

if ( $profile_data->{$allow}{netdomain}{rule}{$fam} == 1 ) {

5692

$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{$fam};

5693

push @data, "${pre}${audit}${allowstr}network $fam,";

5694

} else {

5695

for my $type

5696

(sort keys %{$profile_data->{$allow}{netdomain}{rule}{$fam}}) {

5697

$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{$fam}{$type};

5698

push @data, "${pre}${audit}${allowstr}network $fam $type,";

5699

}

5700

}

5701

}

5702

}

5703

push @data, "" if %{$profile_data->{$allow}{netdomain}};

5704

}

5705

return @data;

5706

5707

}

5708

5709

sub writenetdomain ($$) {

5710

my ($prof_data, $depth) = @_;

5711

my @data;

5712

5713

push @data, writenet_rules($prof_data, $depth, 'deny');

5714

push @data, writenet_rules($prof_data, $depth, 'allow');

5715

5716

return @data;

5717

}

5718

5719

sub writelink_rules ($$$) {

5720

my ($profile_data, $depth, $allow) = @_;

5721

5722

my $allowstr = $allow eq 'deny' ? 'deny ' : '';

5723

my $pre = " " x $depth;

5724

5725

my @data;

5726

if (exists $profile_data->{$allow}{link}) {

5727

for my $path (sort keys %{$profile_data->{$allow}{link}}) {

5728

my $to = $profile_data->{$allow}{link}{$path}{to};

5729

my $subset = ($profile_data->{$allow}{link}{$path}{mode} & $AA_LINK_SUBSET) ? 'subset ' : '';

5730

my $audit = ($profile_data->{$allow}{link}{$path}{audit}) ? 'audit ' : '';

5731

# deal with whitespace in path names

5732

$path = quote_if_needed($path);

5733

$to = quote_if_needed($to);

5734

push @data, "${pre}${audit}${allowstr}link ${subset}${path} -> ${to},";

5735

}

5736

push @data, "";

5737

}

5738

5739

return @data;

5740

}

5741

5742

sub writelinks ($$) {

5743

my ($profile_data, $depth) = @_;

5744

my @data;

5745

5746

push @data, writelink_rules($profile_data, $depth, 'deny');

5747

push @data, writelink_rules($profile_data, $depth, 'allow');

5748

5749

return @data;

5750

}

5751

5752

sub writepath_rules ($$$) {

5753

my ($profile_data, $depth, $allow) = @_;

5754

5755

my $allowstr = $allow eq 'deny' ? 'deny ' : '';

5756

my $pre = " " x $depth;

5757

5758

my @data;

5759

if (exists $profile_data->{$allow}{path}) {

5760

for my $path (sort keys %{$profile_data->{$allow}{path}}) {

5761

my $mode = $profile_data->{$allow}{path}{$path}{mode};

5762

my $audit = $profile_data->{$allow}{path}{$path}{audit};

5763

my $tail = "";

5764

$tail = " -> " . $profile_data->{$allow}{path}{$path}{to} if ($profile_data->{$allow}{path}{$path}{to});

5765

my ($user, $other) = split_mode($mode);

5766

my ($user_audit, $other_audit) = split_mode($audit);

5767

# determine whether the rule contains any owner only components

5768

5769

while ($user || $other) {

5770

my $ownerstr = "";

5771

my ($tmpmode, $tmpaudit) = 0;

5772

if ($user & ~$other) {

5773

# user contains bits not set in other

5774

$ownerstr = "owner ";

5775

$tmpmode = $user & ~$other;

5776

$tmpaudit = $user_audit;

5777

$user &= ~$tmpmode;

5778

# } elsif ($other & ~$user) {

5779

# $ownerstr = "other ";

5780

# $tmpmode = $other & ~$user;

5781

# $tmpaudit = $other_audit;

5782

# $other &= ~$tmpmode;

5783

} else {

5784

if ($user_audit & ~$other_audit & $user) {

5785

$ownerstr = "owner ";

5786

$tmpaudit = $user_audit & ~$other_audit & $user;

5787

$tmpmode = $user & $tmpaudit;

5788

$user &= ~$tmpmode;

5789

# } elsif ($other_audit & ~$user_audit & $other) {

5790

# $ownerstr = "other ";

5791

# $tmpaudit = $other_audit & ~$user_audit & $other;

5792

# $tmpmode = $other & $tmpaudit;

5793

# $other &= ~$tmpmode;

5794

} else {

5795

# user == other && user_audit == other_audit

5796

$ownerstr = "";

5797

#include exclusive other for now

5798

# $tmpmode = $user;

5799

# $tmpaudit = $user_audit;

5800

$tmpmode = $user | $other;

5801

$tmpaudit = $user_audit | $other_audit;

5802

$user &= ~$tmpmode;

5803

$other &= ~$tmpmode;

5804

}

5805

}

5806

5807

if ($tmpmode & $tmpaudit) {

5808

my $modestr = mode_to_str($tmpmode & $tmpaudit);

5809

if ($path =~ /\s/) {

5810

push @data, "${pre}audit ${allowstr}${ownerstr}\"$path\" ${modestr}${tail},";

5811

} else {

5812

push @data, "${pre}audit ${allowstr}${ownerstr}$path ${modestr}${tail},";

5813

}

5814

$tmpmode &= ~$tmpaudit;

5815

}

5816

if ($tmpmode) {

5817

my $modestr = mode_to_str($tmpmode);

5818

if ($path =~ /\s/) {

5819

push @data, "${pre}${allowstr}${ownerstr}\"$path\" ${modestr}${tail},";

5820

} else {

5821

push @data, "${pre}${allowstr}${ownerstr}$path ${modestr}${tail},";

5822

}

5823

}

5824

}

5825

5826

}

5827

push @data, "";

5828

}

5829

5830

return @data;

5831

}

5832

5833

sub writepaths ($$) {

5834

my ($prof_data, $depth) = @_;

5835

5836

my @data;

5837

push @data, writepath_rules($prof_data, $depth, 'deny');

5838

push @data, writepath_rules($prof_data, $depth, 'allow');

5839

5840

return @data;

5841

}

5842

5843

sub write_rules ($$) {

5844

my ($prof_data, $depth) = @_;

5845

5846

my @data;

5847

push @data, writealiases($prof_data, $depth);

5848

push @data, writelistvars($prof_data, $depth);

5849

push @data, writeincludes($prof_data, $depth);

5850

push @data, writerlimits($prof_data, $depth);

5851

push @data, writecapabilities($prof_data, $depth);

5852

push @data, writenetdomain($prof_data, $depth);

5853

push @data, writelinks($prof_data, $depth);

5854

push @data, writepaths($prof_data, $depth);

5855

push @data, writechange_profile($prof_data, $depth);

5856

5857

return @data;

5858

}

5859

5860

sub writepiece ($$$$$);

5861

sub writepiece ($$$$$) {

5862

my ($profile_data, $depth, $name, $nhat, $write_flags) = @_;

5863

5864

my $pre = ' ' x $depth;

5865

my @data;

5866

my $wname;

5867

my $inhat = 0;

5868

if ($name eq $nhat) {

5869

$wname = $name;

5870

} else {

5871

$wname = "$name//$nhat";

5872

$name = $nhat;

5873

$inhat = 1;

5874

}

5875

push @data, writeheader($profile_data->{$name}, $depth, $wname, 0, $write_flags);

5876

push @data, write_rules($profile_data->{$name}, $depth + 1);

5877

5878

my $pre2 = ' ' x ($depth + 1);

5879

# write external hat declarations

5880

for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {

5881

if ($profile_data->{$hat}{declared}) {

5882

push @data, "${pre2}^$hat,";

5883

}

5884

}

5885

5886

if (!$inhat) {

5887

# write embedded hats

5888

for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {

5889

if ((not $profile_data->{$hat}{external}) and

5890

(not $profile_data->{$hat}{declared})) {

5891

push @data, "";

5892

if ($profile_data->{$hat}{profile}) {

5893

push @data, map { "$_" } writeheader($profile_data->{$hat},

5894

$depth + 1, $hat,

5895

1, $write_flags);

5896

} else {

5897

push @data, map { "$_" } writeheader($profile_data->{$hat},

5898

$depth + 1, "^$hat",

5899

1, $write_flags);

5900

}

5901

push @data, map { "$_" } write_rules($profile_data->{$hat},

5902

$depth + 2);

5903

push @data, "${pre2}}";

5904

}

5905

}

5906

push @data, "${pre}}";

5907

5908

#write external hats

5909

for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {

5910

if (($name eq $nhat) and $profile_data->{$hat}{external}) {

5911

push @data, "";

5912

push @data, map { " $_" } writepiece($profile_data, $depth - 1,

5913

$name, $hat, $write_flags);

5914

push @data, " }";

5915

}

5916

}

5917

}

5918

return @data;

5919

}

5920

5921

sub serialize_profile($$$) {

5922

my ($profile_data, $name, $options) = @_;

5923

5924

my $string = "";

5925

my $include_metadata = 0; # By default don't write out metadata

5926

my $include_flags = 1;

5927

if ( $options and ref($options) eq "HASH" ) {

5928

$include_metadata = 1 if ( defined $options->{METADATA} );

5929

$include_flags = 0 if ( defined $options->{NO_FLAGS} );

5930

}

5931

5932

if ($include_metadata) {

5933

# keep track of when the file was last updated

5934

$string .= "# Last Modified: " . localtime(time) . "\n";

5935

5936

# print out repository metadata

5937

if ($profile_data->{$name}{repo} &&

5938

$profile_data->{$name}{repo}{url} &&

5939

$profile_data->{$name}{repo}{user} &&

5940

$profile_data->{$name}{repo}{id}) {

5941

my $repo = $profile_data->{$name}{repo};

5942

$string .= "# REPOSITORY: $repo->{url} $repo->{user} $repo->{id}\n";

5943

} elsif ($profile_data->{$name}{repo}{neversubmit}) {

5944

$string .= "# REPOSITORY: NEVERSUBMIT\n";

5945

}

5946

}

5947

5948

# print out initial comment

5949

if ($profile_data->{$name}{initial_comment}) {

5950

my $comment = $profile_data->{$name}{initial_comment};

5951

$comment =~ s/\\n/\n/g;

5952

$string .= "$comment\n";

5953

}

5954

5955

#bleah this is stupid the data structure needs to be reworked

5956

my $filename = getprofilefilename($name);

5957

my @data;

5958

if ($filelist{$filename}) {

5959

push @data, writealiases($filelist{$filename}, 0);

5960

push @data, writelistvars($filelist{$filename}, 0);

5961

push @data, writeincludes($filelist{$filename}, 0);

5962

}

5963

5964

5965

# XXX - FIXME

5966

#

5967

# # dump variables defined in this file

5968

# if ($variables{$filename}) {

5969

# for my $var (sort keys %{$variables{$filename}}) {

5970

# if ($var =~ m/^@/) {

5971

# my @values = sort @{$variables{$filename}{$var}};

5972

# @values = map { escape($_) } @values;

5973

# my $values = join (" ", @values);

5974

# print SDPROF "$var = ";

5975

# print SDPROF $values;

5976

# } elsif ($var =~ m/^\$/) {

5977

# print SDPROF "$var = ";

5978

# print SDPROF ${$variables{$filename}{$var}};

5979

# } elsif ($var =~ m/^\#/) {

5980

# my $inc = $var;

5981

# $inc =~ s/^\#//;

5982

# print SDPROF "#include <$inc>";

5983

# }

5984

# print SDPROF "\n";

5985

# }

5986

# }

5987

5988

push @data, writepiece($profile_data, 0, $name, $name, $include_flags);

5989

$string .= join("\n", @data);

5990

5991

return "$string\n";

5992

}

5993

5994

sub writeprofile_ui_feedback ($) {

5995

my $profile = shift;

5996

UI_Info(sprintf(gettext('Writing updated profile for %s.'), $profile));

5997

writeprofile($profile);

5998

}

5999

6000

sub writeprofile ($) {

6001

my ($profile) = shift;

6002

6003

my $filename = $sd{$profile}{$profile}{filename} || getprofilefilename($profile);

6004

6005

open(SDPROF, ">$filename") or

6006

fatal_error "Can't write new AppArmor profile $filename: $!";

6007

my $serialize_opts = { };

6008

$serialize_opts->{METADATA} = 1;

6009

6010

#make sure to write out all the profiles in the file

6011

my $profile_string = serialize_profile($sd{$profile}, $profile, $serialize_opts);

6012

print SDPROF $profile_string;

6013

close(SDPROF);

6014

6015

# mark the profile as up-to-date

6016

delete $changed{$profile};

6017

$original_sd{$profile} = dclone($sd{$profile});

6018

}

6019

6020

sub getprofileflags($) {

6021

my $filename = shift;

6022

6023

my $flags = "enforce";

6024

6025

if (open(PROFILE, "$filename")) {

6026

while (<PROFILE>) {

6027

if (m/^\s*\/\S+\s+flags=$(.+)$\s+{\s*$/) {

6028

$flags = $1;

6029

close(PROFILE);

6030

return $flags;

6031

}

6032

}

6033

close(PROFILE);

6034

}

6035

6036

return $flags;

6037

}

6038

6039

6040

sub matchliteral($$) {

6041

my ($sd_regexp, $literal) = @_;

6042

6043

my $p_regexp = convert_regexp($sd_regexp);

6044

6045

# check the log entry against our converted regexp...

6046

my $matches = eval { $literal =~ /^$p_regexp$/; };

6047

6048

# doesn't match if we've got a broken regexp

6049

return undef if $@;

6050

6051

return $matches;

6052

}

6053

6054

# test if profile has exec rule for $exec_target

6055

sub profile_known_exec (\%$$) {

6056

my ($profile, $type, $exec_target) = @_;

6057

if ( $type eq "exec" ) {

6058

my ($cm, $am, @m);

6059

6060

# test denies first

6061

($cm, $am, @m) = rematchfrag($profile, 'deny', $exec_target);

6062

if ($cm & $AA_MAY_EXEC) {

6063

return -1;

6064

}

6065

($cm, $am, @m) = match_prof_incs_to_path($profile, 'deny', $exec_target);

6066

if ($cm & $AA_MAY_EXEC) {

6067

return -1;

6068

}

6069

6070

# now test the generally longer allow lists

6071

($cm, $am, @m) = rematchfrag($profile, 'allow', $exec_target);

6072

if ($cm & $AA_MAY_EXEC) {

6073

return 1;

6074

}

6075

6076

($cm, $am, @m) = match_prof_incs_to_path($profile, 'allow', $exec_target);

6077

if ($cm & $AA_MAY_EXEC) {

6078

return 1;

6079

}

6080

}

6081

return 0;

6082

}

6083

6084

sub profile_known_capability (\%$) {

6085

my ($profile, $capname) = @_;

6086

6087

return -1 if $profile->{deny}{capability}{$capname}{set};

6088

return 1 if $profile->{allow}{capability}{$capname}{set};

6089

for my $incname ( keys %{$profile->{include}} ) {

6090

return -1 if $include{$incname}{$incname}{deny}{capability}{$capname}{set};

6091

return 1 if $include{$incname}{$incname}{allow}{capability}{$capname}{set};

6092

}

6093

return 0;

6094

}

6095

6096

sub profile_known_network (\%$$) {

6097

my ($profile, $family, $sock_type) = @_;

6098

6099

return -1 if netrules_access_check( $profile->{deny}{netdomain},

6100

$family, $sock_type);

6101

return 1 if netrules_access_check( $profile->{allow}{netdomain},

6102

$family, $sock_type);

6103

6104

for my $incname ( keys %{$profile->{include}} ) {

6105

return -1 if netrules_access_check($include{$incname}{$incname}{deny}{netdomain},

6106

$family, $sock_type);

6107

return 1 if netrules_access_check($include{$incname}{$incname}{allow}{netdomain},

6108

$family, $sock_type);

6109

}

6110

6111

return 0;

6112

}

6113

6114

sub netrules_access_check ($$$) {

6115

my ($netrules, $family, $sock_type) = @_;

6116

return 0 if ( not defined $netrules );

6117

my %netrules = %$netrules;

6118

my $all_net = defined $netrules{rule}{all};

6119

my $all_net_family = defined $netrules{rule}{$family} && $netrules{rule}{$family} == 1;

6120

my $net_family_sock = defined $netrules{rule}{$family} &&

6121

ref($netrules{rule}{$family}) eq "HASH" &&

6122

defined $netrules{rule}{$family}{$sock_type};

6123

6124

if ( $all_net || $all_net_family || $net_family_sock ) {

6125

return 1;

6126

} else {

6127

return 0;

6128

}

6129

}

6130

6131

sub reload_base($) {

6132

my $bin = shift;

6133

6134

# don't try to reload profile if AppArmor is not running

6135

return unless check_for_subdomain();

6136

6137

my $filename = getprofilefilename($bin);

6138

6139

system("/bin/cat '$filename' | $parser -I$profiledir -r >/dev/null 2>&1");

6140

}

6141

6142

sub reload ($) {

6143

my $bin = shift;

6144

6145

# don't reload the profile if the corresponding executable doesn't exist

6146

my $fqdbin = findexecutable($bin) or return;

6147

6148

return reload_base($fqdbin);

6149

}

6150

6151

sub read_include_from_file($) {

6152

my $which = shift;

6153

6154

my $data;

6155

if (open(INCLUDE, "$profiledir/$which")) {

6156

local $/;

6157

$data = <INCLUDE>;

6158

close(INCLUDE);

6159

}

6160

6161

return $data;

6162

}

6163

6164

sub get_include_data($) {

6165

my $which = shift;

6166

6167

my $data = read_include_from_file($which);

6168

unless($data) {

6169

fatal_error "Can't find include file $which: $!";

6170

}

6171

return $data;

6172

}

6173

6174

sub loadinclude($) {

6175

my $which = shift;

6176

6177

# don't bother loading it again if we already have

6178

return 0 if $include{$which}{$which};

6179

6180

my @loadincludes = ($which);

6181

while (my $incfile = shift @loadincludes) {

6182

6183

my $data = get_include_data($incfile);

6184

my $incdata = parse_profile_data($data, $incfile, 1);

6185

if ($incdata) {

6186

attach_profile_data(\%include, $incdata);

6187

}

6188

}

6189

return 0;

6190

}

6191

6192

sub rematchfrag ($$$) {

6193

my ($frag, $allow, $path) = @_;

6194

6195

my $combinedmode = 0;

6196

my $combinedaudit = 0;

6197

my @matches;

6198

6199

for my $entry (keys %{ $frag->{$allow}{path} }) {

6200

6201

my $regexp = convert_regexp($entry);

6202

6203

# check the log entry against our converted regexp...

6204

if ($path =~ /^$regexp$/) {

6205

6206

# regexp matches, add it's mode to the list to check against

6207

$combinedmode |= $frag->{$allow}{path}{$entry}{mode};

6208

$combinedaudit |= $frag->{$allow}{path}{$entry}{audit};

6209

push @matches, $entry;

6210

}

6211

}

6212

6213

return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;

6214

}

6215

6216

sub match_include_to_path ($$$) {

6217

my ($incname, $allow, $path) = @_;

6218

6219

my $combinedmode = 0;

6220

my $combinedaudit = 0;

6221

my @matches;

6222

6223

my @includelist = ( $incname );

6224

while (my $incfile = shift @includelist) {

6225

my $ret = eval { loadinclude($incfile); };

6226

if ($@) { fatal_error $@; }

6227

my ($cm, $am, @m) = rematchfrag($include{$incfile}{$incfile}, $allow, $path);

6228

if ($cm) {

6229

$combinedmode |= $cm;

6230

$combinedaudit |= $am;

6231

push @matches, @m;

6232

}

6233

6234

# check if a literal version is in the current include fragment

6235

if ($include{$incfile}{$incfile}{$allow}{path}{$path}) {

6236

$combinedmode |= $include{$incfile}{$incfile}{$allow}{path}{$path}{mode};

6237

$combinedaudit |= $include{$incfile}{$incfile}{$allow}{path}{$path}{audit};

6238

}

6239

6240

# if this fragment includes others, check them too

6241

if (keys %{ $include{$incfile}{$incfile}{include} }) {

6242

push @includelist, keys %{ $include{$incfile}{$incfile}{include} };

6243

}

6244

}

6245

6246

return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;

6247

}

6248

6249

sub match_prof_incs_to_path ($$$) {

6250

my ($frag, $allow, $path) = @_;

6251

6252

my $combinedmode = 0;

6253

my $combinedaudit = 0;

6254

my @matches;

6255

6256

# scan the include fragments for this profile looking for matches

6257

my @includelist = keys %{ $frag->{include} };

6258

while (my $include = shift @includelist) {

6259

my ($cm, $am, @m) = match_include_to_path($include, $allow, $path);

6260

if ($cm) {

6261

$combinedmode |= $cm;

6262

$combinedaudit |= $am;

6263

push @matches, @m;

6264

}

6265

}

6266

6267

return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;

6268

}

6269

6270

#find includes that match the path to suggest

6271

sub suggest_incs_for_path($$$) {

6272

my ($incname, $path, $allow) = @_;

6273

6274

6275

my $combinedmode = 0;

6276

my $combinedaudit = 0;

6277

my @matches;

6278

6279

# scan the include fragments looking for matches

6280

my @includelist = ($incname);

6281

while (my $include = shift @includelist) {

6282

my ($cm, $am, @m) = rematchfrag($include{$include}{$include}, 'allow', $path);

6283

if ($cm) {

6284

$combinedmode |= $cm;

6285

$combinedaudit |= $am;

6286

push @matches, @m;

6287

}

6288

6289

# check if a literal version is in the current include fragment

6290

if ($include{$include}{$include}{allow}{path}{$path}) {

6291

$combinedmode |= $include{$include}{$include}{allow}{path}{$path}{mode};

6292

$combinedaudit |= $include{$include}{$include}{allow}{path}{$path}{audit};

6293

}

6294

6295

# if this fragment includes others, check them too

6296

if (keys %{ $include{$include}{$include}{include} }) {

6297

push @includelist, keys %{ $include{$include}{$include}{include} };

6298

}

6299

}

6300

6301

if ($combinedmode) {

6302

return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;

6303

} else {

6304

return;

6305

}

6306

}

6307

6308

sub check_qualifiers($) {

6309

my $program = shift;

6310

6311

if ($cfg->{qualifiers}{$program}) {

6312

unless($cfg->{qualifiers}{$program} =~ /p/) {

6313

fatal_error(sprintf(gettext("\%s is currently marked as a program that should not have it's own profile. Usually, programs are marked this way if creating a profile for them is likely to break the rest of the system. If you know what you're doing and are certain you want to create a profile for this program, edit the corresponding entry in the [qualifiers] section in /etc/apparmor/logprof.conf."), $program));

6314

}

6315

}

6316

}

6317

6318

sub loadincludes() {

6319

if (opendir(SDDIR, $profiledir)) {

6320

my @incdirs = grep { (!/^\./) && (-d "$profiledir/$_") } readdir(SDDIR);

6321

close(SDDIR);

6322

6323

while (my $id = shift @incdirs) {

6324

next if isSkippableDir($id);

6325

if (opendir(SDDIR, "$profiledir/$id")) {

6326

for my $path (readdir(SDDIR)) {

6327

chomp($path);

6328

next if isSkippableFile($path);

6329

if (-f "$profiledir/$id/$path") {

6330

my $file = "$id/$path";

6331

$file =~ s/$profiledir\///;

6332

my $ret = eval { loadinclude($file); };

6333

if ($@) { fatal_error $@; }

6334

} elsif (-d "$id/$path") {

6335

push @incdirs, "$id/$path";

6336

}

6337

}

6338

closedir(SDDIR);

6339

}

6340

}

6341

}

6342

}

6343

6344

sub globcommon ($) {

6345

my $path = shift;

6346

6347

my @globs;

6348

6349

# glob library versions in both foo-5.6.so and baz.so.9.2 form

6350

if ($path =~ m/[\d\.]+\.so$/ || $path =~ m/\.so\.[\d\.]+$/) {

6351

my $libpath = $path;

6352

$libpath =~ s/[\d\.]+\.so$/*.so/;

6353

$libpath =~ s/\.so\.[\d\.]+$/.so.*/;

6354

push @globs, $libpath if $libpath ne $path;

6355

}

6356

6357

for my $glob (keys %{$cfg->{globs}}) {

6358

if ($path =~ /$glob/) {

6359

my $globbedpath = $path;

6360

$globbedpath =~ s/$glob/$cfg->{globs}{$glob}/g;

6361

push @globs, $globbedpath if $globbedpath ne $path;

6362

}

6363

}

6364

6365

if (wantarray) {

6366

return sort { length($b) <=> length($a) } uniq(@globs);

6367

} else {

6368

my @list = sort { length($b) <=> length($a) } uniq(@globs);

6369

return $list[$#list];

6370

}

6371

}

6372

6373

# this is an ugly, nasty function that attempts to see if one regexp

6374

# is a subset of another regexp

6375

sub matchregexp ($$) {

6376

my ($new, $old) = @_;

6377

6378

# bail out if old pattern has {foo,bar,baz} stuff in it

6379

return undef if $old =~ /\{.*(\,.*)*\}/;

6380

6381

# are there any regexps at all in the old pattern?

6382

if ($old =~ /\[.+\]/ or $old =~ /\*/ or $old =~ /\?/) {

6383

6384

# convert {foo,baz} to (foo|baz)

6385

$new =~ y/\{\}\,/\|/ if $new =~ /\{.*\,.*\}/;

6386

6387

# \001 == SD_GLOB_RECURSIVE

6388

# \002 == SD_GLOB_SIBLING

6389

6390

$new =~ s/\*\*/\001/g;

6391

$new =~ s/\*/\002/g;

6392

6393

$old =~ s/\*\*/\001/g;

6394

$old =~ s/\*/\002/g;

6395

6396

# strip common prefix

6397

my $prefix = commonprefix($new, $old);

6398

if ($prefix) {

6399

6400

# make sure we don't accidentally gobble up a trailing * or **

6401

$prefix =~ s/(\001|\002)$//;

6402

$new =~ s/^$prefix//;

6403

$old =~ s/^$prefix//;

6404

}

6405

6406

# strip common suffix

6407

my $suffix = commonsuffix($new, $old);

6408

if ($suffix) {

6409

6410

# make sure we don't accidentally gobble up a leading * or **

6411

$suffix =~ s/^(\001|\002)//;

6412

$new =~ s/$suffix$//;

6413

$old =~ s/$suffix$//;

6414

}

6415

6416

# if we boiled the differences down to a ** in the new entry, it matches

6417

# whatever's in the old entry

6418

return 1 if $new eq "\001";

6419

6420

# if we've paired things down to a * in new, old matches if there are no

6421

# slashes left in the path

6422

return 1 if ($new eq "\002" && $old =~ /^[^\/]+$/);

6423

6424

# we'll bail out if we have more globs in the old version

6425

return undef if $old =~ /\001|\002/;

6426

6427

# see if we can match * globs in new against literal elements in old

6428

$new =~ s/\002/[^\/]*/g;

6429

6430

return 1 if $old =~ /^$new$/;

6431

6432

} else {

6433

6434

my $new_regexp = convert_regexp($new);

6435

6436

# check the log entry against our converted regexp...

6437

return 1 if $old =~ /^$new_regexp$/;

6438

6439

}

6440

6441

return undef;

6442

}

6443

6444

sub combine_name($$) { return ($_[0] eq $_[1]) ? $_[0] : "$_[0]^$_[1]"; }

6445

sub split_name ($) { my ($p, $h) = split(/\^/, $_[0]); $h ||= $p; ($p, $h); }

6446

6447

##########################

6448

#

6449

# prompt_user($headers, $functions, $default, $options, $selected);

6450

#

6451

# $headers:

6452

# a required arrayref made up of "key, value" pairs in the order you'd

6453

# like them displayed to user

6454

#

6455

# $functions:

6456

# a required arrayref of the different options to display at the bottom

6457

# of the prompt like "(A)llow", "(D)eny", and "Ba(c)on". the character

6458

# contained by ( and ) will be used as the key to select the specified

6459

# option.

6460

#

6461

# $default:

6462

# a required character which is the default "key" to enter when they

6463

# just hit enter

6464

#

6465

# $options:

6466

# an optional arrayref of the choices like the glob suggestions to be

6467

# presented to the user

6468

#

6469

# $selected:

6470

# specifies which option is currently selected

6471

#

6472

# when prompt_user() is called without an $options list, it returns a

6473

# single value which is the key for the specified "function".

6474

#

6475

# when prompt_user() is called with an $options list, it returns an array

6476

# of two elements, the key for the specified function as well as which

6477

# option was currently selected

6478

#######################################################################

6479

6480

sub Text_PromptUser ($) {

6481

my $question = shift;

6482

6483

my $title = $question->{title};

6484

my $explanation = $question->{explanation};

6485

6486

my @headers = (@{ $question->{headers} });

6487

my @functions = (@{ $question->{functions} });

6488

6489

my $default = $question->{default};

6490

my $options = $question->{options};

6491

my $selected = $question->{selected} || 0;

6492

6493

my $helptext = $question->{helptext};

6494

6495

push @functions, "CMD_HELP" if $helptext;

6496

6497

my %keys;

6498

my @menu_items;

6499

for my $cmd (@functions) {

6500

6501

# make sure we know about this particular command

6502

my $cmdmsg = "PromptUser: " . gettext("Unknown command") . " $cmd";

6503

fatal_error $cmdmsg unless $CMDS{$cmd};

6504

6505

# grab the localized text to use for the menu for this command

6506

my $menutext = gettext($CMDS{$cmd});

6507

6508

# figure out what the hotkey for this menu item is

6509

my $menumsg = "PromptUser: " .

6510

gettext("Invalid hotkey in") .

6511

" '$menutext'";

6512

$menutext =~ /$(\S)$/ or fatal_error $menumsg;

6513

6514

# we want case insensitive comparisons so we'll force things to

6515

# lowercase

6516

my $key = lc($1);

6517

6518

# check if we're already using this hotkey for this prompt

6519

my $hotkeymsg = "PromptUser: " .

6520

gettext("Duplicate hotkey for") .

6521

" $cmd: $menutext";

6522

fatal_error $hotkeymsg if $keys{$key};

6523

6524

# keep track of which command they're picking if they hit this hotkey

6525

$keys{$key} = $cmd;

6526

6527

if ($default && $default eq $cmd) {

6528

$menutext = "[$menutext]";

6529

}

6530

6531

push @menu_items, $menutext;

6532

}

6533

6534

# figure out the key for the default option

6535

my $default_key;

6536

if ($default && $CMDS{$default}) {

6537

my $defaulttext = gettext($CMDS{$default});

6538

6539

# figure out what the hotkey for this menu item is

6540

my $defmsg = "PromptUser: " .

6541

gettext("Invalid hotkey in default item") .

6542

" '$defaulttext'";

6543

$defaulttext =~ /$(\S)$/ or fatal_error $defmsg;

6544

6545

# we want case insensitive comparisons so we'll force things to

6546

# lowercase

6547

$default_key = lc($1);

6548

6549

my $defkeymsg = "PromptUser: " .

6550

gettext("Invalid default") .

6551

" $default";

6552

fatal_error $defkeymsg unless $keys{$default_key};

6553

}

6554

6555

my $widest = 0;

6556

my @poo = @headers;

6557

while (my $header = shift @poo) {

6558

my $value = shift @poo;

6559

$widest = length($header) if length($header) > $widest;

6560

}

6561

$widest++;

6562

6563

my $format = '%-' . $widest . "s \%s\n";

6564

6565

my $function_regexp = '^(';

6566

$function_regexp .= join("|", keys %keys);

6567

$function_regexp .= '|\d' if $options;

6568

$function_regexp .= ')$';

6569

6570

my $ans = "XXXINVALIDXXX";

6571

while ($ans !~ /$function_regexp/i) {

6572

# build up the prompt...

6573

my $prompt = "\n";

6574

6575

$prompt .= "= $title =\n\n" if $title;

6576

6577

if (@headers) {

6578

my @poo = @headers;

6579

while (my $header = shift @poo) {

6580

my $value = shift @poo;

6581

$prompt .= sprintf($format, "$header:", $value);

6582

}

6583

$prompt .= "\n";

6584

}

6585

6586

if ($explanation) {

6587

$prompt .= "$explanation\n\n";

6588

}

6589

6590

if ($options) {

6591

for (my $i = 0; $options->[$i]; $i++) {

6592

my $f = ($selected == $i) ? ' [%d - %s]' : ' %d - %s ';

6593

$prompt .= sprintf("$f\n", $i + 1, $options->[$i]);

6594

}

6595

$prompt .= "\n";

6596

}

6597

$prompt .= join(" / ", @menu_items);

6598

print "$prompt\n";

6599

6600

# get their input...

6601

$ans = lc(getkey());

6602

6603

if ($ans) {

6604

# handle escape sequences so you can up/down in the list

6605

if ($ans eq "up") {

6606

6607

if ($options && ($selected > 0)) {

6608

$selected--;

6609

}

6610

$ans = "XXXINVALIDXXX";

6611

6612

} elsif ($ans eq "down") {

6613

6614

if ($options && ($selected < (scalar(@$options) - 1))) {

6615

$selected++;

6616

}

6617

$ans = "XXXINVALIDXXX";

6618

6619

} elsif ($keys{$ans} && $keys{$ans} eq "CMD_HELP") {

6620

6621

print "\n$helptext\n";

6622

$ans = "XXXINVALIDXXX";

6623

6624

} elsif (ord($ans) == 10) {

6625

6626

# pick the default if they hit return...

6627

$ans = $default_key;

6628

6629

} elsif ($options && ($ans =~ /^\d$/)) {

6630

6631

# handle option poo

6632

if ($ans > 0 && $ans <= scalar(@$options)) {

6633

$selected = $ans - 1;

6634

}

6635

$ans = "XXXINVALIDXXX";

6636

}

6637

}

6638

6639

if ($keys{$ans} && $keys{$ans} eq "CMD_HELP") {

6640

print "\n$helptext\n";

6641

$ans = "again";

6642

}

6643

}

6644

6645

# pull our command back from our hotkey map

6646

$ans = $keys{$ans} if $keys{$ans};

6647

return ($ans, $selected);

6648

6649

}

6650

6651

# Parse event record into key-value pairs

6652

sub parse_event($) {

6653

my %ev = ();

6654

my $msg = shift;

6655

chomp($msg);

6656

my $event = LibAppArmor::parse_record($msg);

6657

my ($rmask, $dmask);

6658

6659

$DEBUGGING && debug("parse_event: $msg");

6660

6661

$ev{'resource'} = LibAppArmor::aa_log_record::swig_info_get($event);

6662

$ev{'active_hat'} = LibAppArmor::aa_log_record::swig_active_hat_get($event);

6663

$ev{'sdmode'} = LibAppArmor::aa_log_record::swig_event_get($event);

6664

$ev{'time'} = LibAppArmor::aa_log_record::swig_epoch_get($event);

6665

$ev{'operation'} = LibAppArmor::aa_log_record::swig_operation_get($event);

6666

$ev{'profile'} = LibAppArmor::aa_log_record::swig_profile_get($event);

6667

$ev{'name'} = LibAppArmor::aa_log_record::swig_name_get($event);

6668

$ev{'name2'} = LibAppArmor::aa_log_record::swig_name2_get($event);

6669

$ev{'attr'} = LibAppArmor::aa_log_record::swig_attribute_get($event);

6670

$ev{'parent'} = LibAppArmor::aa_log_record::swig_parent_get($event);

6671

$ev{'pid'} = LibAppArmor::aa_log_record::swig_pid_get($event);

6672

$ev{'task'} = LibAppArmor::aa_log_record::swig_task_get($event);

6673

$ev{'info'} = LibAppArmor::aa_log_record::swig_info_get($event);

6674

$dmask = LibAppArmor::aa_log_record::swig_denied_mask_get($event);

6675

$rmask = LibAppArmor::aa_log_record::swig_requested_mask_get($event);

6676

$ev{'magic_token'} =

6677

LibAppArmor::aa_log_record::swig_magic_token_get($event);

6678

6679

# NetDomain

6680

if ( $ev{'operation'} && optype($ev{'operation'}) eq "net" ) {

6681

$ev{'family'} =

6682

LibAppArmor::aa_log_record::swig_net_family_get($event);

6683

$ev{'protocol'} =

6684

LibAppArmor::aa_log_record::swig_net_protocol_get($event);

6685

$ev{'sock_type'} =

6686

LibAppArmor::aa_log_record::swig_net_sock_type_get($event);

6687

}

6688

6689

LibAppArmor::free_record($event);

6690

6691

#map new c and d to w as logprof doesn't support them yet

6692

if ($rmask) {

6693

$rmask =~ s/c/w/g;

6694

$rmask =~ s/d/w/g;

6695

}

6696

if ($dmask) {

6697

$dmask =~ s/c/w/g;

6698

$dmask =~ s/d/w/g;

6699

}

6700

6701

if ($rmask && !validate_log_mode(hide_log_mode($rmask))) {

6702

fatal_error(sprintf(gettext('Log contains unknown mode %s.'),

6703

$rmask));

6704

}

6705

6706

if ($dmask && !validate_log_mode(hide_log_mode($dmask))) {

6707

fatal_error(sprintf(gettext('Log contains unknown mode %s.'),

6708

$dmask));

6709

}

6710

#print "str_to_mode deny $dmask = " . str_to_mode($dmask) . "\n" if ($dmask);

6711

#print "str_to_mode req $rmask = " . str_to_mode($rmask) . "\n" if ($rmask);

6712

6713

my ($mask, $name);

6714

($mask, $name) = log_str_to_mode($ev{profile}, $dmask, $ev{name2});

6715

$ev{'denied_mask'} = $mask;

6716

$ev{name2} = $name;

6717

6718

($mask, $name) = log_str_to_mode($ev{profile}, $rmask, $ev{name2});

6719

$ev{'request_mask'} = $mask;

6720

$ev{name2} = $name;

6721

6722

if ( ! $ev{'time'} ) { $ev{'time'} = time; }

6723

6724

# remove null responses

6725

for (keys(%ev)) {

6726

if ( ! $ev{$_} || $ev{$_} !~ /[\/\w]+/) { delete($ev{$_}); }

6727

}

6728

6729

if ( $ev{'sdmode'} ) {

6730

#0 = invalid, 1 = error, 2 = AUDIT, 3 = ALLOW/PERMIT,

6731

#4 = DENIED/REJECTED, 5 = HINT, 6 = STATUS/config change

6732

if ( $ev{'sdmode'} == 0 ) { $ev{'sdmode'} = "UNKNOWN"; }

6733

elsif ( $ev{'sdmode'} == 1 ) { $ev{'sdmode'} = "ERROR"; }

6734

elsif ( $ev{'sdmode'} == 2 ) { $ev{'sdmode'} = "AUDITING"; }

6735

elsif ( $ev{'sdmode'} == 3 ) { $ev{'sdmode'} = "PERMITTING"; }

6736

elsif ( $ev{'sdmode'} == 4 ) { $ev{'sdmode'} = "REJECTING"; }

6737

elsif ( $ev{'sdmode'} == 5 ) { $ev{'sdmode'} = "HINT"; }

6738

elsif ( $ev{'sdmode'} == 6 ) { $ev{'sdmode'} = "STATUS"; }

6739

else { delete($ev{'sdmode'}); }

6740

}

6741

if ( $ev{sdmode} ) {

6742

$DEBUGGING && debug( Data::Dumper->Dump([%ev], [qw(*event)]));

6743

return \%ev;

6744

} else {

6745

return( undef );

6746

}

6747

}

6748

6749

###############################################################################

6750

# required initialization

6751

6752

$cfg = read_config("logprof.conf");

6753

if ((not defined $cfg->{settings}{default_owner_prompt})) {

6754

$cfg->{settings}{default_owner_prompt} = 0;

6755

}

6756

6757

$profiledir = find_first_dir($cfg->{settings}{profiledir}) || "/etc/apparmor.d";

6758

unless (-d $profiledir) { fatal_error "Can't find AppArmor profiles."; }

6759

6760

$extraprofiledir = find_first_dir($cfg->{settings}{inactive_profiledir}) ||

6761

"/etc/apparmor/profiles/extras/";

6762

6763

$parser = find_first_file($cfg->{settings}{parser}) || "/sbin/apparmor_parser";

6764

unless (-x $parser) { fatal_error "Can't find apparmor_parser."; }

6765

6766

$filename = find_first_file($cfg->{settings}{logfiles}) || "/var/log/syslog";

6767

unless (-f $filename) { fatal_error "Can't find system log."; }

6768

6769

$ldd = find_first_file($cfg->{settings}{ldd}) || "/usr/bin/ldd";

6770

unless (-x $ldd) { fatal_error "Can't find ldd."; }

6771

6772

$logger = find_first_file($cfg->{settings}{logger}) || "/bin/logger";

6773

unless (-x $logger) { fatal_error "Can't find logger."; }

6774

6775

1;

6776