~ubuntu-branches/ubuntu/feisty/mime-support/feisty : revision 1

1

#! /usr/bin/perl

2

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

3

#

4

# Install-MIME: Install programs into "/etc/mailcap", resolve conflicts,

5

# auto-uninstall, make dinner, and wash dishes.

6

#

7

# Written by Brian White <bcwhite@pobox.com>.

8

#

9

# This program has been placed in the public domain. Do whatever you wish

10

# with it, though I'd appreciate it if my name stayed on it as the original

11

# author.

12

#

13

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

14

#

15

# Options:

16

#

17

# --install Install the entries for specified package

18

# --remove Remove all entries for specified package

19

#

20

# --package=<pkg-name> Name of installing package

21

#

22

# --content=<content-type> Content-Type for specified programs

23

# --test=<conditional> Condition to test if line is valid

24

# --needsterminal=<t/f> Do these programs need a terminal

25

# --copiousoutput=<t/f> Do these programs generate extra output

26

#

27

# --description=<string> Text description for this content-type

28

# --textualnewlines=<t/f> Convert newline to CRLF before encoding

29

# --x11-bitmap=<file> Pathname to X icon bitmap representing type

30

# --nametemplate=<string> Template indicating files of this type

31

# --comment=<string> Comment to display to user at priority list

32

#

33

# --view=<program-string> Command line for viewing this type

34

# --compose=<program-string> Command line for composing this type

35

# --composetyped=<program> Command line for composing specified type

36

# --edit=<program-string> Command line for editing this type

37

# --print=<program-string> Command line for printing this type

38

#

39

# --quiet Avoid unnecessary output

40

# --noparmcheck Don't abort upon detecting a bad parameter

41

#

42

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

43

44

45

46

#

47

# Program Constants

48

#

49

$debug=0;

50

$mimedb="/var/lib/mime/mime-db";

51

$mailcap="/etc/mailcap";

52

$compat="/var/lib/mime/mime-support-compat";

53

$action{view} = "view";

54

$action{compose} = "compose";

55

$action{composetyped} = "compose";

56

$action{edit} = "edit";

57

$action{print} = "print";

58

$action{"x11-bitmap"} = "x11-bitmap";

59

60

61

62

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

63

64

65

66

#

67

# Subrutine to 'uniq' a sorted list

68

#

69

sub uniq {

70

local($last) = "";

71

local(@new) = ();

72

foreach $val (@_) {

73

if ($val ne $last) {

74

$last = $val;

75

push(@new,$val);

76

}

77

}

78

return @new;

79

}

80

81

82

#

83

# Subroutine to output a string and move to next column

84

#

85

sub OutputColumn {

86

my($string,$size) = @_;

87

my $i;

88

89

# $string = substr($string,0,$size-1);

90

print $string, " " x ($size - length($string));

91

}

92

93

94

95

#

96

# Subroutine to reformat text for the screen

97

#

98

sub Reformat {

99

my($string,$size) = @_;

100

my(@letters,$index,$count,$length);

101

$size = 80 unless $size;

102

103

@letters = split(//,$string);

104

$length = @letters;

105

106

$index = 0;

107

$count = 0;

108

while ($index < $length) {

109

$count = $size - 1;

110

if ($count < $length - $index) {

111

$count-- while (@letters[$index + $count] ne ' ');

112

}

113

print substr($string,$index,$count) . "\n";

114

$index += $count + 1;

115

}

116

}

117

118

119

120

#

121

# Subroutine to work around netscape's test bug

122

#

123

sub TestHack {

124

my($test) = @_;

125

my $file = $test;

126

127

$file =~ s/!=/ne/g;

128

$file =~ s/=/eq/g;

129

$file =~ s/&&/and/g;

130

$file =~ s/\|\|/or/g;

131

$file =~ s/\W+//g;

132

133

$file = "/var/lib/mime/tests/".lc($file);

134

135

unless (-x $file) {

136

open(TESTFILE,">$file") || die "$0: could not write '$file' -- $!\n";

137

print TESTFILE '#! /bin/sh',"\n";

138

print TESTFILE $test,"\n";

139

print TESTFILE 'exit $?',"\n";

140

close(TESTFILE);

141

chmod 0755,$file;

142

}

143

144

return $file;

145

}

146

147

148

149

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

150

151

152

153

#

154

# Subroutine to give help for "order"

155

#

156

sub OrderHelp {

157

print <<_END_;

158

159

Because many packages can be installed that are capable of performing actions

160

on the same types of files, it is necessary to specify your preference here.

161

Entries with smaller numbers will be tried first. If they have "test"

162

conditions that will not allow them to work in a given case, the next

163

alternative will be tried. This will continue until a valid entry is found or

164

all possibilities have been exausted.

165

166

For example: Two common ways of view GIF pictures are with the "xv" and the

167

"xloadimage" programs. If the "xv" package were installed and the "xloadimage"

168

package was being installed, you might see something like the following:

169

170

New action 'view' for MIME type 'image/gif' ("gif picture format")...

171

--> package=xloadimage view=xloadimage -view -quiet %s

172

173

1) package=xv view=xv %s

174

175

Place at what priority? (1-2, help) -->

176

177

Selecting "1" would place "xloadimage" as the top priority to be tried before

178

the "xv" program. Selecting "2" would place it after "xv".

179

180

_END_

181

182

print "Press <RETURN> to continue: ";

183

my $enter = <STDIN>;

184

print "\n";

185

}

186

187

188

189

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

190

191

192

193

#

194

# Subroutine to change type information

195

#

196

sub Change {

197

my($content,$field,$value) = @_;

198

199

if ($D{$content} =~ m/$field=(.*?)\t/) {

200

print "Resolving redefined '$field'...\n" if $debug;

201

return if ($1 eq $value);

202

203

# print "\nThis package recommends changing the value of '$field'\n";

204

# print "in the 'mailcap' file.\n\n";

205

# print " old: $1\n";

206

# print " new: $value\n\n";

207

# print "Do you wish to accept the new value? [y] ";

208

# my $resp = <STDIN>;

209

# print "\n";

210

#

211

# return if ($resp =~ m/n/i);

212

}

213

214

$D{$content} =~ s|$field=.*?\t||g;

215

$D{$content} .= "$field=$value\t";

216

}

217

218

219

220

#

221

# Subroutine to choose an ordering

222

#

223

sub Order {

224

my($content,$command,$package,$value,$index) = @_;

225

my $action = $action{$command};

226

my @list = split(/\t/,$O{"$content,$action"});

227

my $size = @list;

228

my @lines;

229

my $i,$pkg,$idx,$other,$resp;

230

231

unless ($size) {

232

$O{"$content,$action"} .= "$package($index)\t";

233

print "- Added new action '$action' for MIME type '$content'\n" unless $A{quiet};

234

return;

235

}

236

237

$max = ($size>9 ? 9 : $size) + 1;

238

239

do {

240

my $desc="";

241

$desc=" ($A{description})" if $A{description};

242

print "\nNew action '$action' for MIME type '$content'$desc...\n";

243

print "-->\tpackage=$package\t$value\n";

244

Reformat("Note: $A{comment}") if $A{comment};

245

print "\n";

246

for ($i=1; $i < $max; $i++) {

247

($pkg,$idx) = ($list[$i-1] =~ m/(.*?)$(\d+)$/);

248

$other = $P{$pkg};

249

@lines = split(/\n/,$other);

250

$other = $lines[$idx];

251

$other =~ s|content=.*?\t||;

252

$other =~ s|action=.*?\t||;

253

print "$i)\t$other\n";

254

}

255

print "\nPlace at what priority (1-$max, help)? [1] ";

256

$resp = <STDIN>;

257

print "\n";

258

chomp($resp);

259

if ($resp =~ m/^h$/ || $resp =~ m/^help$/) {

260

OrderHelp();

261

} elsif ($resp eq "") {

262

$resp = 1;

263

}

264

$resp = int($resp);

265

} while ($resp < 1 || $resp > $max);

266

267

$O{"$content,$action"} = "";

268

for ($i=1; $i <= $size; $i++) {

269

$O{"$content,$action"} .= "$package($index)\t" if ($i == $resp);

270

$O{"$content,$action"} .= "$list[$i-1]\t";

271

}

272

$O{"$content,$action"} .= "$package($index)\t" if ($i == $resp);

273

}

274

275

276

277

#

278

# Subroutine to insert an ability for a package

279

#

280

sub Insert {

281

my($pkg,$typ,$act,$prg,$tst,$flg) = @_;

282

my $value = "$act=$prg";

283

my $flags;

284

my $index;

285

my @list;

286

287

die "$0: semicolons are not allowed in commands -- use || or &&\n" if $prg=~m/;/ || $tst=~m/;/;

288

289

$value .= "; test=$tst" if $tst;

290

$value .= "; $flg" if $flg;

291

292

if ($P{$pkg} =~ m/package=\Q$pkg\E\tcontent=\Q$typ\E\t\Q$value\E\n/) {

293

print "- Ignoring already installed content '$typ' with value '$value'\n" if $debug;

294

return;

295

}

296

297

my(@index)= ($P{$pkg} =~ m/\n/g);

298

$index = @index;

299

$P{$pkg} .= "package=$pkg\tcontent=$typ\t$value\n";

300

301

print "Adding new action '$act' for package '$pkg' at index #$index\n" if $debug;

302

Order($typ,$act,$pkg,$value,$index);

303

}

304

305

306

307

#

308

# Subroutine to generate mailcap entries

309

#

310

sub GenMailcap {

311

my($path) = @_;

312

my(@list);

313

my(@content);

314

my($action);

315

316

@list = %O;

317

while (@list) {

318

my($idx) = shift @list;

319

my($val) = shift @list;

320

my($content,$action) = ($idx =~ m/^(.*),(.*)$/);

321

push @content,$content;

322

}

323

@content = uniq(sort(@content));

324

325

foreach $content (@content) {

326

my $flags;

327

if ($D{$content} =~ m/description=(.*?)\t/) { $flags .= "; description=$1"; }

328

if ($D{$content} =~ m/textualnewlines=(.*?)\t/) { $flags .= "; textualnewlines=1"; }

329

if ($D{$content} =~ m/nametemplate=(.*?)\t/) { $flags .= "; nametemplate=$1"; }

330

331

if ($O{"$content,x11-bitmap"} =~ m/(.*?)$(\d+)$\t/) {

332

$P{$1} =~ m/x11-bitmap=(.*?)\n/s;

333

$flags .= "; x11-bitmap=$1";

334

}

335

336

print "* * * Printing content '$content'... ($flags)\n" if $debug;

337

foreach $action ("view","compose","edit","print") {

338

print " * * Printing action '$action'...\n" if $debug;

339

my $order = $O{"$content,$action"};

340

my $prior = 5;

341

foreach (split(/\t/,$order)) {

342

my($pkg,$idx) = m/(.*?)$(\d+)$/;

343

my @values = split(/\n/,$P{$pkg});

344

my $value = $values[$idx];

345

$value =~ s|package=.*?\tcontent=.*?\t||;

346

# print " * Fixing test for package '$_'... ($value)\n" if $debug;

347

# $value =~ s/test=(.*?)(;|$)/"test=".TestHack($1).$2/e; # Hack to fix Netscape's test bug

348

print " * Printing package '$_'... ($value)\n" if $debug;

349

if ($value =~ /^view=/) {

350

$value =~ s|view=||;

351

print $path "$content; $value$flags; priority=$prior\n";

352

} else {

353

print $path "$content; echo \"No viewer for type '$content'\"; $value$flags; priority=$prior\n";

354

}

355

$prior--;

356

$prior = 0 if ($prior < 0);

357

}

358

}

359

}

360

}

361

362

363

364

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

365

366

367

368

#

369

# "Remove" subroutine

370

#

371

sub Remove {

372

my $pkg = $A{package};

373

my @list;

374

375

@list = %O;

376

while (@list) {

377

my $order = shift @list;

378

my $names = shift @list;

379

380

$O{$order} =~ s|$pkg$\d+$\t||g;

381

unless ($O{$order}) {

382

my($content,$action) = ($order =~ m/(.*),(.*)/);

383

print "- There is now nothing as '$2' for MIME type '$1'\n" unless $A{quiet};

384

}

385

}

386

387

undef $P{$pkg};

388

$changed=1;

389

}

390

391

392

393

#

394

# "Install" subroutine

395

#

396

sub Install {

397

my @list = %A;

398

while (@list) {

399

my $arg = shift @list;

400

my $val = shift @list;

401

402

if ($arg =~ m/^(description|textualnewlines|nametemplate)$/ && $val) {

403

Change($A{content},$arg,$val);

404

}

405

}

406

407

Insert($A{package},$A{content},"x11-bitmap",$A{"x11-bitmap"}) if $A{"x11-bitmap"};

408

409

my $flags = "";

410

$flags .= "; needsterminal" if $A{needsterminal} =~ m/[Tt]/;

411

$flags .= "; copiousoutput" if $A{copiousoutput} =~ m/[Tt]/;

412

$flags .= "; textualnewlines" if $A{textualnewlines} =~ m/[Tt]/;

413

$flags =~s|^; ||;

414

415

@list = %A;

416

while (@list) {

417

my $arg = shift @list;

418

my $val = shift @list;

419

420

if ($arg =~ m/^(view|compose|composetyped|edit|print)$/ && $val) {

421

die "Error: action '$arg' ($val) cannot be backgrounded within mailcap\n" if $val=~m/\&\s*$/;

422

Insert($A{package},$A{content},$arg,$val,$A{test},$flags);

423

$changed=1;

424

}

425

}

426

}

427

428

429

430

#

431

# "List" subroutine

432

#

433

sub List {

434

my @list = %O;

435

436

while (@list) {

437

my $order = shift @list;

438

my $value = shift @list;

439

my($content,$action) = ($order =~ m/(.*),(.*)/);

440

441

next if $A{content} && $content !~ m/^$A{content}/;

442

next if $A{package} && $value !~ m/$A{package}\(/;

443

444

print "\n$content: ";

445

$D{$content} =~ m/description=(.*?)\t/;

446

print " \"$1\"" if $1;

447

print " ($action)\n";

448

449

foreach (split(/\t/,$value)) {

450

my($package,$index) = (m/(.*)$(\d+)$/);

451

my @pkgdata = split(/\n/,$P{$package});

452

next if $A{package} && $A{package} ne $package;

453

454

OutputColumn($package,20);

455

456

# print "\nExtracting from line: $pkgdata[$index]\n" if $debug;

457

my($command) = ($pkgdata[$index] =~ m/$action.*?=([^;]*)/);

458

my($test) = ($pkgdata[$index] =~ m/(test=[^\t]*)/);

459

OutputColumn($command,40);

460

print " $test\n";

461

}

462

}

463

464

print "\n";

465

}

466

467

468

469

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

470

471

472

473

#

474

# Initialization

475

#

476

print STDOUT ""; $| = 1; # No 'autoflush' because perl may not be configured

477

478

479

480

#

481

# Valid parameters

482

#

483

$A{install} = -1;

484

$A{remove} = -1;

485

$A{list} = -1;

486

$A{package} = '@';

487

$A{content} = '@';

488

$A{comment} = '@';

489

$A{test} = '@';

490

$A{needsterminal} = '@';

491

$A{copiousoutput} = '@';

492

$A{description} = '@';

493

$A{textualnewlines} = '@';

494

$A{"x11-bitmap"} = '@';

495

$A{nametemplate} = '@';

496

$A{view} = '@';

497

$A{compose} = '@';

498

$A{composetyped} = '@';

499

$A{edit} = '@';

500

$A{print} = '@';

501

$A{quiet} = -1;

502

$A{noparmcheck} = -1;

503

504

505

506

#

507

# Look for parameter parsing flags (i.e. "--noparmcheck")

508

#

509

$strictparms = 1;

510

foreach (@ARGV) {

511

/^--noparmcheck$/ and $strictparms = 0;

512

}

513

#print "($0: parameter checking disabled)\n" unless $strictparms;

514

515

516

#

517

# Parameter parsing

518

#

519

foreach (@ARGV) {

520

my($p,$v);

521

522

s/[\n\t ]+/ /g;

523

524

if (/^--(.*?)=(.*)$/) {

525

$p=$1; $v=$2;

526

} elsif (/^--([^=]*)$/) {

527

$p=$1; $v=1;

528

} else {

529

die "$0: bad parameter '$_'\n" if $strictparms;

530

$p=$_; $v=1;

531

}

532

die "$0: unknown option '--$p'\n" if !$A{$p} and $strictparms;

533

die "$0: redefined option '--$p'\n" if ($A{$p} && $A{$p} ne '@' && $A{$p} != -1);

534

535

print "Setting '$p' = '$v'\n" if $debug;

536

$A{$p} = $v;

537

}

538

539

540

#

541

# Don't use this program any more

542

#

543

print STDERR "Warning: 'install-mime' is obsolete -- use 'update-mime' instead (see man page)\n" if $strictparms;

544

545

546

#

547

# Remove any undefined parameters and do simple sanity check

548

#

549

@list = %A;

550

while (@list) {

551

my($parm) = shift @list;

552

my($valu) = shift @list;

553

undef $A{$parm} if $valu == -1;

554

undef $A{$parm} if $valu eq '@';

555

die "$0: missing mandatory option '--$parm'\n" if $valu eq '*';

556

}

557

558

die "$0: '--install' and '--remove' are mutually exclusive options\n" if $A{install} && $A{remove};

559

die "$0: install requires '--package' and '--content'\n" if $A{install} && (! $A{package} || ! $A{content});

560

die "$0: remove requires '--package'\n" if $A{remove} && ! $A{package};

561

die "$0: no action given!\n" unless $A{install} || $A{remove} || $A{list};

562

die "$0: content-type must be explicit (no '*' allowed)\n" if $A{content} =~ m/\*/;

563

564

print "$0: (warning) content-type '$A{content}' is not 'type/subtype'\n" if $A{content} && $A{content} !~ m|^[^/]+/[^/]+$|;

565

566

$A{content} = lc($A{content}) if $A{content};

567

568

569

#

570

# Load database

571

#

572

if (-f $mimedb) {

573

open(PATH,"<$mimedb") || die "$0: could not read database '$mimedb' -- $!\n";

574

while (<PATH>) {

575

if (m/^content=(.*?)\taction=(.*?)\t(.*)\n$/) {

576

my($idx) = "$1,$2";

577

die "$0: database corruption! (multiple 'content=$1, action=$2' lines)\n" if $O{$idx};

578

$O{$idx} = $3;

579

} elsif (m/^content=(.*?)\t(.*)\n$/) {

580

die "$0: database corruption! (multiple 'content=$1;<data>' lines)\n" if $D{$1};

581

$D{$1} = $2;

582

} elsif (m/^package=(.*?)\t/) {

583

$P{$1} .= $_;

584

} else {

585

chop;

586

die "$0: database corruption! (unknown line '$_')\n";

587

}

588

}

589

close PATH;

590

}

591

592

593

594

#

595

# Do actions specified by user

596

#

597

$changed=0;

598

Remove if $A{remove};

599

Install if $A{install};

600

List if $A{list};

601

602

exit 0 unless $changed; # stop here if no changes were made

603

604

605

#

606

# Generate new mailcap file if necessary

607

#

608

open(PATH,">$compat") || die "$0: could not write '$compat' -- $!\n";

609

GenMailcap(PATH);

610

close PATH;

611

612

613

#

614

# Write data back to the database

615

#

616

open (PATH,">$mimedb") || die "$0: could not write database '$mimedb' -- $!\n";

617

618

@list = %O;

619

while (@list) {

620

my $idx = shift @list;

621

my $val = shift @list;

622

$idx =~ m/(.*?),(.*)/;

623

print PATH "content=$1\taction=$action{$2}\t$val\n" if $val;

624

}

625

626

@list = %D;

627

while (@list) {

628

my $idx = shift @list;

629

my $val = shift @list;

630

print PATH "content=$idx\t$val\n";

631

}

632

633

@list = %P;

634

while (@list) {

635

my $idx = shift @list;

636

my $val = shift @list;

637

print PATH $val;

638

}

639

640

close PATH;

641

642

643

#

644

# Run new 'update-mime' program

645

#

646

exec "/usr/sbin/update-mime";