Pascal (Lazarus/Delphi)
Pascal (Lazarus/Delphi)
Amazon Glacier Set Vault Access Policy
See more Amazon Glacier Examples
Demonstrates how to set an access policy for a vault (will overwrite the existing policy).Chilkat Pascal (Lazarus/Delphi) Downloads
program ChilkatDemo;
// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
SysUtils,
CkDllLoader,
Chilkat.AuthAws,
Chilkat.Rest,
Chilkat.JsonObject,
Chilkat.StringBuilder;
// ---------------------------------------------------------------------------
procedure RunDemo;
var
success: Boolean;
rest: TRest;
bTls: Boolean;
port: Integer;
bAutoReconnect: Boolean;
authAws: TAuthAws;
jsonPolicy: TJsonObject;
json: TJsonObject;
sbRequestBody: TStringBuilder;
sbResponseBody: TStringBuilder;
respStatusCode: Integer;
begin
success := False;
// This example requires the Chilkat API to have been previously unlocked.
// See Global Unlock Sample for sample code.
rest := TRest.Create;
// Connect to the Amazon AWS REST server in the desired region.
bTls := True;
port := 443;
bAutoReconnect := True;
success := rest.Connect('glacier.us-west-2.amazonaws.com',port,bTls,bAutoReconnect);
// Provide AWS credentials.
authAws := TAuthAws.Create;
authAws.AccessKey := 'AWS_ACCESS_KEY';
authAws.SecretKey := 'AWS_SECRET_KEY';
authAws.ServiceName := 'glacier';
authAws.Region := 'us-west-2';
success := rest.SetAuthAws(authAws);
// --------------------------------------------------------------------------
// Note: The above REST connection and setup of the AWS credentials
// can be done once. After connecting, any number of REST calls can be made.
// The "auto reconnect" property passed to rest.Connect indicates that if
// the connection is lost, a REST method call will automatically reconnect
// if needed.
// --------------------------------------------------------------------------
// For more information, see Glacier Set Vault Access Policy Reference Documentation
//
rest.AddHeader('x-amz-glacier-version','2012-06-01');
// Create the following JSON
// Use this online tool to generate the code from sample JSON:
// Generate Code to Create JSON
// {
// "Version": "2012-10-17",
// "Statement": [
// {
// "Sid": "Define-owner-access-rights",
// "Effect": "Allow",
// "Principal": {
// "AWS": "arn:aws:iam::AWS_ACCOUNT_ID:root"
// },
// "Action": "glacier:DeleteArchive",
// "Resource": "arn:aws:glacier:us-west-2:AWS_ACCOUNT_ID:vaults/chilkat"
// }
// ]
// }
jsonPolicy := TJsonObject.Create;
jsonPolicy.UpdateString('Version','2012-10-17');
jsonPolicy.UpdateString('Statement[0].Sid','Define-owner-access-rights');
jsonPolicy.UpdateString('Statement[0].Effect','Allow');
jsonPolicy.UpdateString('Statement[0].Principal.AWS','arn:aws:iam::AWS_ACCOUNT_ID:root');
jsonPolicy.UpdateString('Statement[0].Action','glacier:DeleteArchive');
// Notice here the name of the vault: "chilkat". Change it to your vault name. Also use your actual AWS account ID.
jsonPolicy.UpdateString('Statement[0].Resource','arn:aws:glacier:us-west-2:AWS_ACCOUNT_ID:vaults/chilkat');
// Wrap the above JSON in this JSON:
// {
// "Policy": "{ ... the above JSON ... }"
// }
json := TJsonObject.Create;
json.UpdateString('Policy',jsonPolicy.Emit());
sbRequestBody := TStringBuilder.Create;
json.EmitSb(sbRequestBody);
sbResponseBody := TStringBuilder.Create;
success := rest.FullRequestSb('PUT','/AWS_ACCOUNT_ID/vaults/chilkat/access-policy',sbRequestBody,sbResponseBody);
if (success <> True) then
begin
WriteLn(rest.LastErrorText);
Exit;
end;
respStatusCode := rest.ResponseStatusCode;
if (respStatusCode >= 400) then
begin
WriteLn('Response Status Code = ' + respStatusCode);
WriteLn('Response Header:');
WriteLn(rest.ResponseHeader);
WriteLn('Response Body:');
WriteLn(sbResponseBody.GetAsString());
Exit;
end;
// Success is indicated by a 204 response status with an empty response body.
WriteLn('response status code = ' + respStatusCode);
rest.Free;
authAws.Free;
jsonPolicy.Free;
json.Free;
sbRequestBody.Free;
sbResponseBody.Free;
end;
// ---------------------------------------------------------------------------
begin
try
RunDemo;
except
on E: Exception do
WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
end;
WriteLn;
{$IFDEF MSWINDOWS}
WriteLn('Press Enter to exit...');
ReadLn;
{$ENDIF}
end.